From: www Date: Sun, 29 Sep 2024 21:23:59 +0000 (+0000) Subject: Mirrored from /srv/git/yakumo.izuru/kosuzu.git X-Git-Url: https://git.chaotic.ninja/gitweb/yakumo_izuru/?a=commitdiff_plain;ds=inline;p=kosuzu.git Mirrored from /srv/git/yakumo.izuru/kosuzu.git git-svn-id: https://svn.chaotic.ninja/svn/kosuzu-yakumo.izuru@1 2c30a6ee-1393-a14f-93a8-d14122039704 --- 06d63e3e8f954e6eed638ad15e849b15f93babf0 diff --git a/branches/master/.gitignore b/branches/master/.gitignore new file mode 100644 index 0000000..7281ccd --- /dev/null +++ b/branches/master/.gitignore @@ -0,0 +1,12 @@ +.merlin +.logarion +*.ymd +\#*\# +.\#*1 +*~ +*.o +*.native +_build +*.htm +index.html +/.svn diff --git a/branches/master/LICENSE b/branches/master/LICENSE new file mode 100644 index 0000000..fa3348e --- /dev/null +++ b/branches/master/LICENSE @@ -0,0 +1,153 @@ +EUROPEAN UNION PUBLIC LICENCE v. 1.2 +EUPL © the European Union 2007, 2016 + +This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such use is covered by a right of the copyright holder of the Work). + +The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following notice immediately following the copyright notice for the Work: + +Licensed under the EUPL + +or has expressed by any other means his willingness to license under the EUPL. + +1. Definitions +In this Licence, the following terms have the following meaning: + +— ‘The Licence’: this Licence. + +— ‘The Original Work’: the work or software distributed or communicated by the Licensor under this Licence, available as Source Code and also as Executable Code as the case may be. + +— ‘Derivative Works’: the works or software that could be created by the Licensee, based upon the Original Work or modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in the country mentioned in Article 15. + +— ‘The Work’: the Original Work or its Derivative Works. + +— ‘The Source Code’: the human-readable form of the Work which is the most convenient for people to study and modify. + +— ‘The Executable Code’: any code which has generally been compiled and which is meant to be interpreted by a computer as a program. + +— ‘The Licensor’: the natural or legal person that distributes or communicates the Work under the Licence. + +— ‘Contributor(s)’: any natural or legal person who modifies the Work under the Licence, or otherwise contributes to the creation of a Derivative Work. + +— ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of the Work under the terms of the Licence. + +— ‘Distribution’ or ‘Communication’: any act of selling, giving, lending, renting, distributing, communicating, transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential functionalities at the disposal of any other natural or legal person. + +2. Scope of the rights granted by the Licence +The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for the duration of copyright vested in the Original Work: + +— use the Work in any circumstance and for all usage, + +— reproduce the Work, + +— modify the Work, and make Derivative Works based upon the Work, + +— communicate to the public, including the right to make available or display the Work or copies thereof to the public and perform publicly, as the case may be, the Work, + +— distribute the Work or copies thereof, + +— lend and rent the Work or copies thereof, + +— sublicense rights in the Work or copies thereof. + +Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the applicable law permits so. + +In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed by law in order to make effective the licence of the economic rights here above listed. + +The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the extent necessary to make use of the rights granted on the Work under this Licence. + +3. Communication of the Source Code +The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to distribute or communicate the Work. + +4. Limitations on copyright +Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations thereto. + +5. Obligations of the Licensee +The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those obligations are the following: + +Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work to carry prominent notices stating that the Work has been modified and the date of modification. +Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless the Original Work is expressly distributed only under this version of the Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the Work or Derivative Work that alter or restrict the terms of the Licence. +Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. +Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available for as long as the Licensee continues to distribute or communicate the Work. +Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the copyright notice. +6. Chain of Authorship +The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contri butions to the Work, under the terms of this Licence. + +7. Disclaimer of Warranty +The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work and may therefore contain defects or ‘bugs’ inherent to this type of development. + +For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this Licence. + +This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. + +8. Disclaimer of Liability +Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. + +9. Additional agreements +While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by the fact You have accepted any warranty or additional liability. + +10. Acceptance of the Licence +The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms and conditions. + +Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution or Communication by You of the Work or copies thereof. + +11. Information to the public +In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, by offering to download the Work from a remote location) the distribution channel or media (for example, a website) must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence and the way it may be accessible, concluded, stored and reproduced by the Licensee. + +12. Termination of the Licence +The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms of the Licence. + +Such a termination will not terminate the licences of any person who has received the Work from the Licensee under the Licence, provided such persons remain in full compliance with the Licence. + +13. Miscellaneous +Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the Work. + +If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid and enforceable. + +The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. New versions of the Licence will be published with a unique version number. + +All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take advantage of the linguistic version of their choice. + +14. Jurisdiction +Without prejudice to specific agreement between parties, + +— any litigation resulting from the interpretation of this License, arising between the European Union institutions, bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, + +— any litigation arising between other parties and resulting from the interpretation of this License, will be subject to the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. + +15. Applicable Law +Without prejudice to specific agreement between parties, + +— this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, resides or has his registered office, + +— this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside a European Union Member State. + +Appendix +‘Compatible Licences’ according to Article 5 EUPL are: + +— GNU General Public License (GPL) v. 2, v. 3 + +— GNU Affero General Public License (AGPL) v. 3 + +— Open Software License (OSL) v. 2.1, v. 3.0 + +— Eclipse Public License (EPL) v. 1.0 + +— CeCILL v. 2.0, v. 2.1 + +— Mozilla Public Licence (MPL) v. 2 + +— GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 + +— Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software + +— European Union Public Licence (EUPL) v. 1.1, v. 1.2 + +— Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) + +The European Commission may update this Appendix to later versions of the above licences without producing a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the covered Source Code from exclusive appropriation. + +All other changes or additions to this Appendix require the production of a new EUPL version. diff --git a/branches/master/Makefile b/branches/master/Makefile new file mode 100644 index 0000000..1baf879 --- /dev/null +++ b/branches/master/Makefile @@ -0,0 +1,31 @@ +OS=`uname -s` +MACHINE=`uname -m` +DATE=`date -r _build/default/cmd/txt/txt.exe +%Y%m%d` +COMMIT=`git rev-parse --short HEAD` +PREFIX=/usr/local + +CC=cc +LD=cc + +all: + @dune build +deps: + @opam install dune ocurl cmdliner msgpck +txt: + @dune build cmd/txt/txt.exe +clean: + @dune clean +dist: + @dune build + @cp _build/default/cmd/txt/txt.exe txt.exe + @strip txt.exe + @tar czvf "kosuzu-${OS}-${MACHINE}-${DATE}-${COMMIT}" txt.exe readme.txt + @rm txt.exe + +txt_init: + @dune build cmd/txt_init/txt_init.exe +install: + @dune install --prefix ${PREFIX} +uninstall: + @dune uninstall --prefix ${PREFIX} +.PHONY: txt txt_init diff --git a/branches/master/README.md b/branches/master/README.md new file mode 100644 index 0000000..700fb9c --- /dev/null +++ b/branches/master/README.md @@ -0,0 +1,5 @@ +# Kosuzu +Text archival and exchange, named after [Kosuzu Motoori](https://en.touhouwiki.net/wiki/Kosuzu_Motoori) from [Forbidden Scrollery](https://en.touhouwiki.net/wiki/Forbidden_Scrollery). + +## Contact +* [Mailing list](mailto:kosuzu-dev@chaotic.ninja) diff --git a/branches/master/TODO.md b/branches/master/TODO.md new file mode 100644 index 0000000..f289c40 --- /dev/null +++ b/branches/master/TODO.md @@ -0,0 +1,3 @@ +# To-do +* Support [geomyidae](gopher://bitreich.org/1/scm/geomyidae) `.gph` indexes, for now those can be generated manually somewhat +* Support tab-separated value gophermaps for any other gopher daemon diff --git a/branches/master/cmd/txt/atom.ml b/branches/master/cmd/txt/atom.ml new file mode 100644 index 0000000..aab1b53 --- /dev/null +++ b/branches/master/cmd/txt/atom.ml @@ -0,0 +1,71 @@ +let ext = ".atom" + +let esc = Converter.Html.esc + +let element tag content = "<" ^ tag ^ ">" ^ content ^ "" + +let opt_element tag_name content = + if content <> "" + then element tag_name content + else "" + +module P = Parsers.Plain_text.Make (Converter.Html) + +let id txt = "urn:txtid:" ^ Kosuzu.(txt.Text.id) ^ "\n" +let title text = "" ^ esc text.Kosuzu.Text.title ^ "\n" + +let authors text = + let u acc addr = acc ^ element "uri" addr in + let open Kosuzu in + let fn txt a = + a ^ "" ^ (opt_element "name" @@ esc txt.Person.name) + ^ (List.fold_left u "" txt.Person.addresses) + ^ "\n" in + Person.Set.fold fn text.Text.authors "" + +let updated txt = let open Kosuzu in + ""^ Date.(txt.Text.date |> listing |> rfc_string) ^"\n" + +let htm_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let gmi_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let base_url kv protocol = try + let locs = Kosuzu.Store.KV.find "Locations" kv in + let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in + Str.(matched_string locs) + with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; "" + +let indices alternate_type c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let title = try Kosuzu.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in + let entry, fname, protocol_regexp = match alternate_type with + | "text/gemini" -> gmi_entry, "gmi.atom", "gemini" + | "text/html" | _ -> htm_entry, "feed.atom", "https?" + in + let base_url = base_url c.kv protocol_regexp in + let self = Filename.concat base_url fname in + file fname @@ (*TODO: alternate & self per url*) + {||} + ^ title ^ {|urn:txtid:|} ^ c.Conversion.id ^ "" + ^ Kosuzu.Date.now () ^ "\n" + ^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" c.texts + ^ "" + +let converter format = Conversion.{ ext; page = None; indices = Some (indices format) } diff --git a/branches/master/cmd/txt/authors.ml b/branches/master/cmd/txt/authors.ml new file mode 100644 index 0000000..6fd77cc --- /dev/null +++ b/branches/master/cmd/txt/authors.ml @@ -0,0 +1,22 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories too") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"topics" ~doc: "Display authors who have written on topics") + +let authors_t = Term.(const authors $ recurse $ topics) + +let cmd = + let doc = "List authors" in + let man = [ + `S Manpage.s_description; + `P "List author names" ] + in + let info = Cmd.info "authors" ~doc ~man in + Cmd.v info authors_t diff --git a/branches/master/cmd/txt/conversion.ml b/branches/master/cmd/txt/conversion.ml new file mode 100644 index 0000000..12f74aa --- /dev/null +++ b/branches/master/cmd/txt/conversion.ml @@ -0,0 +1,74 @@ +open Kosuzu + +module Rel = struct + +module Rel_set = Set.Make(String) +module Id_map = Map.Make(String) + +type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t } +type map_t = t Id_map.t + +let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty } +let empty_map = Id_map.empty + +let acc_ref date source target = Id_map.update target (function + | None -> Some { last_rel = date; + ref_set = Rel_set.singleton source; + rep_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + ref_set = Rel_set.add source rel.ref_set }) + +let acc_rep date source target = Id_map.update target (function + | None -> Some { last_rel = date; + rep_set = Rel_set.singleton source; + ref_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + rep_set = Rel_set.add source rel.rep_set }) + +let acc_txt rels (text, _paths) = + let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in + let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in + let rels = String_set.fold acc_ref (Text.set "references" text) rels in + let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in + rels + +let acc_pck rels peer = + let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in + try Header_pack.fold + (fun rels id t _title _authors _topics refs_ls reps_ls -> + let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in + let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in + rels) + rels peer.Peers.pack + with e -> prerr_endline "acc_pck"; raise e +end + + +type t = { + id: string; + dir: string; + kv: string Store.KV.t; + topic_roots: string list; + topics: (String_set.t * String_set.t) Topic_set.Map.t; + relations: Rel.map_t; + texts: Text.t list +} + +type fn_t = { + ext: string; + page: (t -> Kosuzu.Text.t -> string) option; + indices: (t -> unit) option; +} + +let empty () = { + id = ""; dir = ""; + kv = Store.KV.empty; + topic_roots = []; + topics = Topic_set.Map.empty; + relations = Rel.Id_map.empty; + texts = [] +} diff --git a/branches/master/cmd/txt/convert.ml b/branches/master/cmd/txt/convert.ml new file mode 100644 index 0000000..4ee7de2 --- /dev/null +++ b/branches/master/cmd/txt/convert.ml @@ -0,0 +1,95 @@ +open Kosuzu + +let is_older s d = try Unix.((stat d).st_mtime < (stat s).st_mtime) with _-> true + +let convert cs r (text, files) = match Text.str "Content-Type" text with + | "" | "text/plain" -> + let source = List.hd files in + let dest = Filename.concat r.Conversion.dir (Text.short_id text) in + List.fold_left (fun a f -> + match f.Conversion.page with None -> false || a + | Some page -> + let dest = dest ^ f.Conversion.ext in + (if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations + then (File_store.file dest (page r text); true) else false) + || a) + false cs + | x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false + +let converters types kv = + let n = String.split_on_char ',' types in + let t = [] in + let t = if List.(mem "all" n || mem "htm" n) then (Html.converter kv)::t else t in + let t = if List.(mem "all" n || mem "atom" n) then (Atom.converter "text/html")::t else t in + let t = if List.(mem "all" n || mem "gmi" n) then (Gemini.converter)::t else t in + let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in + t + +let directory converters noindex repo = + let order = File_store.oldest in + let repo = + let open Conversion in + let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in + let relations = Peers.fold Rel.acc_pck rels in + { repo with relations } in + let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls, + if convert converters repo r then acc+1 else acc in + let topics, texts, count = + File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in + let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv) + with Not_found -> Topic_set.roots topics in + let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in + if not noindex then + List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters; + Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts) + +let load_kv dir = + let kv = File_store.of_kv_file () in + let idx = Filename.concat dir "index.pck" in + if not (Sys.file_exists idx) then kv else + match Header_pack.of_string @@ File_store.to_string (idx) with + | Error s -> prerr_endline s; kv + | Ok { info; peers; _ } -> + let kv = if Store.KV.mem "Id" kv then kv else Store.KV.add "Id" info.Header_pack.id kv in + let kv = if Store.KV.mem "Title" kv then kv else Store.KV.add "Title" info.Header_pack.title kv in + let kv = if Store.KV.mem "Locations" kv then kv else Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in + let kv = Store.KV.add "Peers" (String.concat ";\n" Header_pack.(to_str_list peers)) kv in + kv + +let at_path types noindex path = match path with + | "" -> prerr_endline "unspecified text file or directory" + | path when Sys.file_exists path -> + if Sys.is_directory path then ( + let kv = load_kv path in + let repo = { (Conversion.empty ()) with dir = path; kv } in + directory (converters types kv) noindex repo + ) else ( + match File_store.to_text path with + | Error s -> prerr_endline s + | Ok text -> + let dir = "." in + let open Conversion in + let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in + let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in + ignore @@ convert (converters types repo.kv) repo (text, [path]) + ) + | path -> Printf.eprintf "Path doesn't exist: %s" path + +open Cmdliner + +let path = Arg.(value & pos 0 string "" & info [] ~docv:"path" ~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)") +let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type" ~doc:"Convert to file type") +let noindex = Arg.(value & flag & info ["noindex"] ~doc:"Don't create indices in target format") + +let convert_t = Term.(const at_path $ types $ noindex $ path) + +let cmd = + let doc = "Convert texts" in + let man = [ + `S Manpage.s_description; + `P "Convert text or indexed texts within a directory to another format."; + `P "If path is a directory must contain an index.pck."; + `P "Run `txt index` first." ] + in + let info = Cmd.info "convert" ~doc ~man in + Cmd.v info convert_t diff --git a/branches/master/cmd/txt/dune b/branches/master/cmd/txt/dune new file mode 100644 index 0000000..471ab7f --- /dev/null +++ b/branches/master/cmd/txt/dune @@ -0,0 +1,6 @@ +(executable + (name txt) + (public_name txt) + (modules txt authors convert conversion edit file index last listing + new topics html atom gemini peers pull recent unfile) + (libraries text_parse.converter text_parse.parsers kosuzu msgpck curl str cmdliner)) diff --git a/branches/master/cmd/txt/edit.ml b/branches/master/cmd/txt/edit.ml new file mode 100644 index 0000000..298e52c --- /dev/null +++ b/branches/master/cmd/txt/edit.ml @@ -0,0 +1,22 @@ +open Cmdliner +let id = Arg.(value & pos 0 string "" & info [] ~docv: "text ID") +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts by topics") + +let edit_t = Term.(const (Kosuzu.Archive.apply_sys_util "EDITOR" "nano") $ recurse $ time $ reverse $ number $ authed $ topics $ id) + +let cmd = + let doc = "Edit a text" in + let man = [ + `S Manpage.s_description; + `P "Launches EDITOR (nano if environment variable is unset) with text path as parameter."; + `P "If -R is used, the ID search space includes texts found in subdirectories, too."; + `S Manpage.s_environment; + `P "EDITOR - Default editor name" ] + in + let info = Cmd.info "edit" ~doc ~man in + Cmd.v info edit_t diff --git a/branches/master/cmd/txt/file.ml b/branches/master/cmd/txt/file.ml new file mode 100644 index 0000000..cea07c8 --- /dev/null +++ b/branches/master/cmd/txt/file.ml @@ -0,0 +1,23 @@ +open Kosuzu +let file files = + let dirs, files = File_store.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 + +open Cmdliner +let files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") +let file_t = Term.(const file $ files) + +let cmd = + let doc = "File texts in subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Files all texts in parameter in every directory in parameter, using hardlinks"; + `P "Use it to create sub-repositories for sharing or converting" ] + in + let info = Cmd.info "file" ~doc ~man in + Cmd.v info file_t diff --git a/branches/master/cmd/txt/gemini.ml b/branches/master/cmd/txt/gemini.ml new file mode 100644 index 0000000..e2136c3 --- /dev/null +++ b/branches/master/cmd/txt/gemini.ml @@ -0,0 +1,100 @@ +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 Kosuzu.Text in + "# " ^ text.title + ^ "\nAuthors: " ^ Kosuzu.Person.Set.to_string text.authors + ^ "\nDate: " ^ Kosuzu.Date.(pretty_date @@ listing text.date) + ^ let module T = Parsers.Plain_text.Make (GeminiConverter) in + "\n" ^ T.of_string text.body "" + +let date_index title meta_list = + List.fold_left + (fun a m -> + a ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " ^ + Kosuzu.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n") + ("# " ^ title ^ "\n\n## Posts by date\n\n") meta_list + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list + in + List.fold_left + (fun a m -> + a + ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " + ^ Kosuzu.(Date.(pretty_date (listing m.Text.date))) ^ " " + ^ m.Kosuzu.Text.title ^ "\n") + "" meta_list + +let topic_link root topic = + 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 open Kosuzu in + "=> " ^ path ^ Text.short_id meta ^ ".gmi " + ^ Date.(pretty_date (listing meta.Text.date)) ^ " " + ^ meta.Text.title ^ "\n" + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) + and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x + in + item_group topic_roots + +let fold_topic_roots topic_roots = + let list_item root t = topic_link root t in + List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots) + +let topic_main_index r title topic_roots metas = + "# " ^ title ^ "\n\n" + ^ (if topic_roots <> [] then ("## Main topics\n\n" ^ fold_topic_roots topic_roots) else "") + ^ "\n## Latest\n\n" ^ to_dated_links ~limit:10 metas + ^ "\n=> index.date.gmi More by date\n\n" + ^ let peers = Kosuzu.Store.KV.find "Peers" r.Conversion.kv in + if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf "%s=> %s\n" a s) "## Peers\n\n" + (Str.split (Str.regexp ";\n") peers) + +let topic_sub_index title topic_map topic_root metas = + "# " ^ title ^ "\n\n" + ^ listing_index topic_map [topic_root] "" metas + +let indices r = + let open Kosuzu 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 r 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 converter = Conversion.{ ext; page = Some page; indices = Some indices} diff --git a/branches/master/cmd/txt/html.ml b/branches/master/cmd/txt/html.ml new file mode 100644 index 0000000..7fec0d6 --- /dev/null +++ b/branches/master/cmd/txt/html.ml @@ -0,0 +1,181 @@ +type templates_t = { header: string option; footer: string option } +type t = { templates : templates_t; style : string } + +let ext = ".htm" +let empty_templates = { header = None; footer = None } +let default_opts = { templates = empty_templates; style = "" } + +let init kv = + let open Kosuzu in + let to_string key kv = match Store.KV.find key kv with + | fname -> Some (File_store.to_string fname) + | exception Not_found -> None in + let header = to_string "HTM-header" kv in + let footer = to_string "HTM-footer" kv in + let style = match to_string "HTM-style" kv with + | Some s -> Printf.sprintf "\n" s | None -> "" in + { templates = { header; footer}; style } + +let wrap conv htm text_title body = + let site_title = try Kosuzu.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in + let replace x = let open Str in + global_replace (regexp "{{archive-title}}") site_title x + |> global_replace (regexp "{{text-title}}") text_title + in + let feed = try Kosuzu.Store.KV.find "HTM-feed" conv.Conversion.kv + with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom") + then "feed.atom" else "" in + let header = match htm.templates.header with + | Some x -> replace x + | None -> Printf.(sprintf "%s%s" site_title + (if feed <> "" then sprintf "feed" feed else "")) + in + let footer = match htm.templates.footer with None -> "" | Some x -> replace x in + Printf.sprintf "\n\n\n\n%s%s\n%s\n%s\n\n\n\n\n\n%s%s%s\n" + text_title (if site_title <> "" then (" • " ^ site_title) else "") + htm.style + (if feed <> "" then Printf.sprintf "" feed else "") + header body footer + +let topic_link root topic = + let replaced_space = String.map (function ' '->'+' | x->x) in + "" + ^ String.capitalize_ascii topic ^ "" + +module HtmlConverter = struct + include Converter.Html + let uid_uri u a = Printf.sprintf "%s<%s>" a u ext u + let angled_uri u a = + if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false + then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a +end + +let page htm conversion text = + let open Kosuzu in + let open Text 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 opt_kv key value = if String.length value > 0 + then "
" ^ key ^ "
" ^ value else "" in + let authors = Person.Set.to_string text.authors in + let header = + let time x = Printf.sprintf {||} +(Date.rfc_string x) (Date.pretty_date x) in + let topic_links x = + let to_linked t a = + let ts = Topic_set.of_string t in + sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in + String_set.fold to_linked x "" in + let ref_links x = + let link l = HtmlConverter.uid_uri l "" in + String_set.fold (fun r a -> sep_append a (link r)) x "" in + let references, replies = let open Conversion in + let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in + ref_links ref_set, ref_links rep_set in + "
" + ^ opt_kv "Title:" text.title + ^ opt_kv "Authors:" authors + ^ opt_kv "Date:" (time (Date.listing text.date)) + ^ opt_kv "Series:" (str_set "series" text) + ^ opt_kv "Topics:" (topic_links (set "topics" text)) + ^ opt_kv "Id:" text.id + ^ opt_kv "Refers:" (ref_links (set "references" text)) + ^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text)) + ^ opt_kv "Referred by:" references + ^ opt_kv "Replies:" replies + ^ {|
|} in
+        wrap conversion htm text.title ((T.of_string text.body header) ^ "
") + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list in + List.fold_left + (fun a m -> Printf.sprintf "%s
  • %s %s" a Kosuzu.(Date.(pretty_date (listing m.Text.date))) + (Kosuzu.Text.short_id m) m.Kosuzu.Text.title) + "" meta_list + +let date_index ?(limit) conv htm meta_list = + match limit with + | Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list) + | None -> wrap conv htm "Index" (to_dated_links meta_list) + +let fold_topic_roots topic_roots = + let list_item root t = "
  • " ^ topic_link root t in + "" + +let fold_topics topic_map topic_roots metas = + let open Kosuzu in + let rec unordered_list root topic = + List.fold_left (fun a x -> a ^ list_item root x) "
      " topic + ^ "
    " + and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) +and list_item root t = + let item = + if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas + then topic_link root t else String.capitalize_ascii t in + "
    • " ^ item ^ sub_items root t ^ "
    " in + "" + +let text_item path meta = + let open Kosuzu in + " |} ^ meta.Text.title + ^ "
    " + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) +and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> {|

    |} ^ String.capitalize_ascii topic ^ "

    " ^ x in + "" + +let topic_main_index conv htm topic_roots metas = + wrap conv htm "Topics" + (fold_topic_roots topic_roots + ^ "
    More by date|} +^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in +(if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf {|%s
  • %s|} a s s) "

    Peers

      " + (Str.split (Str.regexp ";\n") (Kosuzu.Store.KV.find "Peers" conv.kv)) + ^ "
    ")) + +let topic_sub_index conv htm topic_map topic_root metas = + wrap conv htm topic_root + (fold_topics topic_map [topic_root] metas + ^ listing_index topic_map [topic_root] "" metas) + +let indices htm c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" 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 converter kv = + let htm = init kv in + Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) } diff --git a/branches/master/cmd/txt/index.ml b/branches/master/cmd/txt/index.ml new file mode 100644 index 0000000..a5fd2ed --- /dev/null +++ b/branches/master/cmd/txt/index.ml @@ -0,0 +1,93 @@ +open Kosuzu + +let text_editor name x = + let fname, out = Filename.open_temp_file name "" in + output_string out x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let line = input_line inp in + close_in inp; line + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let text_editor_lines name x = + let fname, out = Filename.open_temp_file name "" in + List.iter (fun s -> output_string out (s ^ "\n")) x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let lines = + let rec acc a = + try let a = String.trim (input_line inp) :: a in acc a + with End_of_file -> a in + acc [] in + close_in inp; lines + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let print_pack pck = + let s ss = String.concat "\n\t" ss in + let open Header_pack in + Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n" + pck.info.id pck.info.title (String.concat "," pck.info.people) + (s pck.info.locations) (s (to_str_list pck.peers)) + +type t = { dir : string; index_path: string; pck : Header_pack.t } + +let index r print title auth locs peers = + let edit name index param = if print then index else match param with + | Some "" -> text_editor name index | Some p -> p + | None -> index in + let edits name index param = if print then index else match param with + | Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p + | None -> index in + let edits_mp name index param = if print then index else match param with + | Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index)) + | Some p -> Header_pack.str_list (String_set.list_of_csv p) + | None -> index in + let info = Header_pack.{ r.pck.info with + title = edit "Title" r.pck.info.title title; + people = edits "People" r.pck.info.people auth; + locations = edits "Locations" r.pck.info.locations locs; + } in + let pack = Header_pack.{ info; fields; + texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) []; + peers = edits_mp "Peers" r.pck.peers peers; + } in + if print then print_pack pack + else (File_store.file r.index_path (Header_pack.string pack)) + +let load dir = + let kv = File_store.of_kv_file () in + let index_path = Filename.concat dir "index.pck" in + index { dir; index_path; pck = Header_pack.of_kv kv } + +open Cmdliner +let print = Arg.(value & flag & info ["print"] ~doc: "Print info") +let title = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv: "string" ~doc: "Title for index") +let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv: "Comma-separated names" ~doc: "Index authors") +let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "location"] ~docv: "Comma-separated URLs" ~doc: "Repository URLs") +let peers = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv: "Comma-separated URLs" ~doc: "URLs to other known text repositories") +let dir = Arg.(value & pos 0 string "." & info [] ~docv: "Directory to index") + +let index_t = Term.(const load $ dir $ print $ title $ auth $ locs $ peers) + +let cmd = + let doc = "Generate an index.pck for texts in a directory" in + let man = [ + `S Manpage.s_description; + `P "An index contains:\n"; + `P "* n info section with: title for the index, the authors, locations (URLs) the texts can be accessed."; + `P "* listing of texts with: ID, date, title, authors, topics."; + `P "* list of other text repositories (peers)"; + `S Manpage.s_environment; + `P "EDITOR - Default editor name"; + `S Manpage.s_see_also; + `P "MessagePack format. https://msgpack.org" ] in + let info = Cmd.info "index" ~doc ~man in + Cmd.v info index_t diff --git a/branches/master/cmd/txt/last.ml b/branches/master/cmd/txt/last.ml new file mode 100644 index 0000000..b5bf31e --- /dev/null +++ b/branches/master/cmd/txt/last.ml @@ -0,0 +1,35 @@ +open Kosuzu + +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' + +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' + +let last search_mine = + let filter = if search_mine then last_mine else last in + match File_store.fold filter None with + | None -> () + | Some (_, f) -> List.iter print_endline f + +open Cmdliner + +let mine = Arg.(value & flag & info ["mine"] ~doc: "Last text authored by me") +let last_t = Term.(const last $ mine) + +let cmd = + let doc = "Most recent text" in + let man = [ + `S Manpage.s_description; + `P "Print the filename of most recent text" ] + in + let info = Cmd.info "last" ~doc ~man in + Cmd.v info last_t diff --git a/branches/master/cmd/txt/listing.ml b/branches/master/cmd/txt/listing.ml new file mode 100644 index 0000000..fefd3a6 --- /dev/null +++ b/branches/master/cmd/txt/listing.ml @@ -0,0 +1,44 @@ +open Kosuzu +module FS = File_store +module A = Archive + +let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt dir = + let dir = if dir = "" then FS.txtdir () else dir in + let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let list_text (t, fnames) = Printf.printf "%s | %s | %s | %s %s\n" + (Text.short_id t) Date.(pretty_date @@ listing t.Text.date) + (Person.Set.to_string ~names_only:true t.Text.authors) + t.Text.title (if paths_opt then (List.fold_left (Printf.sprintf "%s\n@ %s") "" fnames) else "") + in + match order_opt with + | false -> FS.iter ~r ~dir ~predicate list_text + | true -> + let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in + match number_opt with + | Some number -> FS.iter ~r ~dir ~predicate ~order ~number list_text + | None -> FS.iter ~r ~dir ~predicate ~order list_text + +open Cmdliner + +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "comma-separated topics" ~doc: "Texts by topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "directory to index") + +let listing_t = Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics $ dir) + +let cmd = + let doc = "List texts" in + let man = [ + `S Manpage.s_description; + `P "Displays text id, date, author, title for a directory."; + `P "If directory argument is omitted, TXTDIR is used, where empty value defaults to ~/.local/share/texts."; + `P "If -R is used, list header information for texts found in subdirectories, too." ] + in + let info = Cmd.info "list" ~doc ~man in + Cmd.v info listing_t diff --git a/branches/master/cmd/txt/new.ml b/branches/master/cmd/txt/new.ml new file mode 100644 index 0000000..73f4ebe --- /dev/null +++ b/branches/master/cmd/txt/new.ml @@ -0,0 +1,29 @@ +open Kosuzu +open Cmdliner + +let new_txt title topics_opt = + let kv = Kosuzu.File_store.of_kv_file () in + let authors = Person.Set.of_string (try Kosuzu.Store.KV.find "Authors" kv + with Not_found -> Sys.getenv "USER") in + let text = { (Text.blank ()) with title; authors } in + let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _->text in + match File_store.with_text text with + | Error s -> prerr_endline s + | Ok (filepath, _note) -> + print_endline filepath + +let title = Arg.(value & pos 0 string "" & info [] ~docv: "title" ~doc: "Title for new article") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv: "Comma-separated topics" ~doc: "Topics for new article") + +let new_t = Term.(const new_txt $ title $ topics) + +let cmd = + let doc = "Create a new article" in + let man = [ + `S Manpage.s_description; + `P "Create a new article"; + `S Manpage.s_environment; + `P "USER - The login name of the user, used if the Authors field is blank" ] + in + let info = Cmd.info "new" ~doc ~man in + Cmd.v info new_t diff --git a/branches/master/cmd/txt/peers.ml b/branches/master/cmd/txt/peers.ml new file mode 100644 index 0000000..25753b4 --- /dev/null +++ b/branches/master/cmd/txt/peers.ml @@ -0,0 +1,42 @@ +let print_peers_of_peer p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_peer () peer = + let open Kosuzu.Peers in + Printf.printf "%s" peer.path; + List.iter (Printf.printf "\t%s\n") peer.pack.info.locations + +let remove_repo id = + let repopath = Filename.concat Kosuzu.Peers.text_dir id in + match Sys.is_directory repopath with + | false -> Printf.eprintf "No repository %s in %s" id Kosuzu.Peers.text_dir + | true -> + let cmd = Printf.sprintf "rm -r %s" repopath in + Printf.printf "Run: %s ? (y/N) %!" cmd; + match input_char stdin with + |'y'-> if Sys.command cmd = 0 then print_endline "Removed" else prerr_endline "Failed" + | _ -> () + +let peers = function + | Some id -> remove_repo id + | None -> + Printf.printf "Peers in %s\n" Kosuzu.Peers.text_dir; + Kosuzu.Peers.fold print_peer () + +open Cmdliner +let remove = Arg.(value & opt (some string) None & info ["remove"] ~docv:"Repository ID" ~doc:"Remove repository texts and from future pulling") +let peers_t = Term.(const peers $ remove) + +let cmd = + let doc = "List current peers" in + let man = [ + `S Manpage.s_description; + `P "List current peers and associated information" ] + in + let info = Cmd.info "peers" ~doc ~man in + Cmd.v info peers_t diff --git a/branches/master/cmd/txt/pull.ml b/branches/master/cmd/txt/pull.ml new file mode 100644 index 0000000..7b5766f --- /dev/null +++ b/branches/master/cmd/txt/pull.ml @@ -0,0 +1,137 @@ +let writer accum data = + Buffer.add_string accum data; + String.length data + +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; + 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 Kosuzu.File_store.to_text @@ Filename.(concat dir (Kosuzu.Id.short id) ^ ".txt") with + | Error x -> prerr_endline x; true + | Ok txt -> time > (Kosuzu.(Header_pack.date (Date.listing txt.date))) + | exception (Sys_error _) -> true + +let print_peers p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_pull_start width total title dir = + Printf.printf "%*d/%s %s => %s %!" width 0 total title dir + +let print_pull width total i = + Printf.printf "\r%*d/%s %!" width (i+1) total + +let printers total title dir = + let width = String.length total in + print_pull_start width total title dir; + print_pull width total + +let fname dir text = Filename.concat dir (Kosuzu.Text.short_id text ^ ".txt") + +let pull_text url dir id = + let u = Filename.concat url ((Kosuzu.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 Kosuzu.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 per_text url dir filter print i id time title authors topics _refs _reps = match id with + | "" -> Printf.eprintf "\nInvalid id for %s\n" title + | id -> let open Kosuzu in + print i; + if newer time id dir + && (String_set.empty = filter.topics + || String_set.exists (fun t -> List.mem t topics) filter.topics) + && (Person.Set.empty = filter.authors + || Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors) + then pull_text url dir id + +let pull_index url authors_opt topics_opt = + let index_url = Filename.concat url "index.pck" in + match curl_pull index_url with + | Error s -> prerr_endline s; false + | Ok body -> + match Kosuzu.Header_pack.of_string (Buffer.contents body) with + | Error s -> Printf.printf "Error with %s: %s\n" url s; false + | Ok pk when pk.info.id = "" -> + Printf.printf "Empty ID index.pck, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_length pk.info.id) -> + Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_chars pk.info.id) -> + Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false + | Ok pk -> + let dir = Filename.concat Kosuzu.Peers.text_dir pk.info.id in + Kosuzu.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 ( Kosuzu.Header_pack.string { + pk with info = { pk.info with locations = url::pk.info.locations }}); + close_out file; + let filter = let open Kosuzu in { + authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty); + topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty); + } in + let name = match pk.info.title with "" -> url | title -> title in + let print = printers (string_of_int @@ Kosuzu.Header_pack.numof_texts pk) name dir in + try Kosuzu.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true + with Invalid_argument msg -> Printf.printf "\nFailed to parse %s: %s\n%!" url msg; false + +let pull_list auths topics = + Curl.global_init Curl.CURLINIT_GLOBALALL; + let pull got_one peer_url = if got_one then got_one else + (pull_index peer_url auths topics) in + let open Kosuzu in + let fold_locations init peer = + ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations; + false + in + ignore @@ Peers.fold fold_locations false; + Curl.global_cleanup () + +let pull url auths topics = match url with + | "" -> pull_list auths topics | x -> ignore (pull_index x auths topics) + +open Cmdliner +let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"Comma-separated names" ~doc:"Filter by authors") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"Comma-separated topics" ~doc:"Filter by topics") +let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"Repository location") + +let pull_t = Term.(const pull $ url $ authors $ topics) + +let cmd = + let doc = "Pull listed texts" in + let man = [ + `S Manpage.s_description; + `P "Pull texts from known repositories." ] + in + let info = Cmd.info "pull" ~doc ~man in + Cmd.v info pull_t diff --git a/branches/master/cmd/txt/recent.ml b/branches/master/cmd/txt/recent.ml new file mode 100644 index 0000000..3b46085 --- /dev/null +++ b/branches/master/cmd/txt/recent.ml @@ -0,0 +1,23 @@ +open Kosuzu +module FS = File_store +module A = Archive + +open Cmdliner +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) (Some 10) & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts with topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "Directory to index") + +let recent_t = Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics $ dir) +let cmd = + let doc = "List recent texts" in + let man = [ + `S Manpage.s_description; + `P "List header information of most recent texts."; + `P "If -R is used, list header information for texts found in subdirectories, too, along with their filepaths" ] + in + let info = Cmd.info "recent" ~doc ~man in + Cmd.v info recent_t diff --git a/branches/master/cmd/txt/topics.ml b/branches/master/cmd/txt/topics.ml new file mode 100644 index 0000000..9c2c936 --- /dev/null +++ b/branches/master/cmd/txt/topics.ml @@ -0,0 +1,21 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated authors" ~doc: "Topics by authors") +let topics_t = Term.(const topics $ recurse $ authed) + +let cmd = + let doc = "List topics" in + let man = [ + `S Manpage.s_description; + `P "List of topics" ] + in + let info = Cmd.info "topics" ~doc ~man in + Cmd.v info topics_t diff --git a/branches/master/cmd/txt/txt.ml b/branches/master/cmd/txt/txt.ml new file mode 100644 index 0000000..a105d3c --- /dev/null +++ b/branches/master/cmd/txt/txt.ml @@ -0,0 +1,36 @@ +open Cmdliner + +let subs = [ + Authors.cmd; + Convert.cmd; + Edit.cmd; + File.cmd; + Index.cmd; + Last.cmd; + Listing.cmd; + New.cmd; + Peers.cmd; + Pull.cmd; + Recent.cmd; + Topics.cmd; + Unfile.cmd; + ] + +let default_cmd = Term.(ret (const (`Help (`Pager, None)))) + +let txt = + let doc = "Discover, collect and exchange texts" in + let man = [ + `S Manpage.s_authors; + `P "orbifx "; + `P "Izuru Yakumo "; + `S Manpage.s_bugs; + `P "Please report them at "; + `S Manpage.s_see_also; + `P "This program is named after Kosuzu Motoori from Touhou Suzunaan: Forbidden Scrollery"; + `P "https://en.touhouwiki.net/wiki/Forbidden_Scrollery" ] + in + Cmd.group (Cmd.info "txt" ~version:"%%VERSION%%" ~doc ~man) ~default:default_cmd subs + +let main () = exit (Cmd.eval txt) +let () = main () diff --git a/branches/master/cmd/txt/unfile.ml b/branches/master/cmd/txt/unfile.ml new file mode 100644 index 0000000..7d29aef --- /dev/null +++ b/branches/master/cmd/txt/unfile.ml @@ -0,0 +1,21 @@ +open Kosuzu + +let unfile files = + let dirs, files = File_store.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 files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") + +let unfile_t = Term.(const unfile $ files) + +let cmd = + let doc = "Unfile texts from subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Unfile texts in parameter from directories in parameter, by removing hardlinks" ] + in + let info = Cmd.info "unfile" ~doc ~man in + Cmd.v info unfile_t diff --git a/branches/master/cmd/txt_init/dune b/branches/master/cmd/txt_init/dune new file mode 100644 index 0000000..6090b4e --- /dev/null +++ b/branches/master/cmd/txt_init/dune @@ -0,0 +1,5 @@ +(executable + (name txt_init) + (public_name txt_init) + (modules txt_init) + (libraries kosuzu)) diff --git a/branches/master/cmd/txt_init/txt_init.ml b/branches/master/cmd/txt_init/txt_init.ml new file mode 100644 index 0000000..30b9c53 --- /dev/null +++ b/branches/master/cmd/txt_init/txt_init.ml @@ -0,0 +1,17 @@ +let init_repo = + print_endline "Initializing repository..."; + print_endline "It's required for the repository name and id."; + print_endline "Create one? (y/n)"; + match input_line stdin with + |"y"-> + let title = + print_endline "Title for repository: "; + input_line stdin in + let authors = + print_endline "Authors (format: name ): "; + input_line stdin in + Kosuzu.File_store.file "txt.conf" + (Printf.sprintf "Id:%s\nTitle: %s\nAuthors: %s\n" (Kosuzu.Id.generate ()) title authors); + Kosuzu.File_store.of_kv_file () + | _ -> + print_endline "Aborting..."; exit 1 diff --git a/branches/master/dune-project b/branches/master/dune-project new file mode 100644 index 0000000..6603f46 --- /dev/null +++ b/branches/master/dune-project @@ -0,0 +1,16 @@ +(lang dune 2.0) +(name kosuzu) +(version 1.4.3) +(license EUPL-1.2) +(authors "orbifx ") +(bug_reports "mailto:kosuzu-dev@chaotic.ninja") +(maintainers "Izuru Yakumo ") +(homepage "https://suzunaan.chaotic.ninja/kosuzu/") +(source (uri git+https://git.chaotic.ninja/yakumo.izuru/kosuzu)) + +(generate_opam_files true) + +(package + (name kosuzu) + (synopsis "Texts archival and exchange") + (depends ocaml dune ocurl msgpck cmdliner)) diff --git a/branches/master/kosuzu.opam b/branches/master/kosuzu.opam new file mode 100644 index 0000000..550e165 --- /dev/null +++ b/branches/master/kosuzu.opam @@ -0,0 +1,25 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "1.4.3" +synopsis: "Texts archival and exchange" +maintainer: ["Izuru Yakumo "] +authors: ["orbifx "] +license: "EUPL-1.2" +homepage: "https://suzunaan.chaotic.ninja/kosuzu/" +bug-reports: "mailto:kosuzu-dev@chaotic.ninja" +depends: ["ocaml" "dune" "ocurl" "msgpck" "cmdliner"] +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://git.chaotic.ninja/yakumo.izuru/kosuzu" diff --git a/branches/master/lib/archive.ml b/branches/master/lib/archive.ml new file mode 100644 index 0000000..a04d660 --- /dev/null +++ b/branches/master/lib/archive.ml @@ -0,0 +1,36 @@ +let predicate fn opt = Option.(to_list @@ map fn opt) + +let authored query_string = + let q = Person.Set.of_query @@ String_set.query query_string in + fun n -> Person.Set.predicate q n.Text.authors + +let ided query_string = + let len = String.length query_string in + fun n -> + try String.sub n.Text.id 0 len = query_string + with Invalid_argument _ -> false + +let keyworded query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Keywords" n)) + +let topics query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Topics" n)) + +let apply_sys_util env def_env r order_opt reverse_opt number_opt authors_opt topics_opt id_opt = + let predicates = if id_opt <> "" then [ ided id_opt ] else [] + @ predicate authored authors_opt + @ predicate topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let util = try Sys.getenv env with Not_found -> def_env in + let print_text acc (_t, fnames) = Printf.sprintf "%s %s" acc (List.hd fnames) in + let paths = match order_opt with + | false -> File_store.fold ~r ~predicate print_text "" + | true -> + let order = match reverse_opt with true -> File_store.newest | false -> File_store.oldest in + match number_opt with + | Some number -> File_store.fold ~r ~predicate ~order ~number print_text "" + | None -> File_store.fold ~r ~predicate ~order print_text "" + in if paths = "" then () + else (ignore @@ Sys.command @@ Printf.sprintf "%s %s" util paths) diff --git a/branches/master/lib/category.ml b/branches/master/lib/category.ml new file mode 100644 index 0000000..ac807b6 --- /dev/null +++ b/branches/master/lib/category.ml @@ -0,0 +1,22 @@ +module Category = struct + type t = Unlisted | Published | Invalid | Custom of string + let compare = Stdlib.compare + let of_string = function "unlisted" | "published" -> Invalid | c -> Custom c + let to_string = function Custom c -> c | _ -> "" +end + +include Category + +module CategorySet = struct + include Set.Make (Category) + let of_stringset s = String_set.fold (fun e a -> add (Category.of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set + let of_string x = of_stringset (String_set.of_string x) + let to_string set = + let f elt a = + let s = Category.to_string elt in + if a <> "" then a ^ ", " ^ s else s + in + fold f set "" +end diff --git a/branches/master/lib/date.ml b/branches/master/lib/date.ml new file mode 100644 index 0000000..6eab0d9 --- /dev/null +++ b/branches/master/lib/date.ml @@ -0,0 +1,22 @@ +type t = { created: string; edited: string } +let compare = compare +let rfc_string date = date +let of_string (rfc : string) = rfc +let listing date = if date.edited <> "" then date.edited else date.created +let months = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|] +let pretty_date date = + try Scanf.sscanf date "%4s-%d-%2s" (fun y m d -> Printf.sprintf "%s %s, %s" d (months.(m-1)) y) + with + | Scanf.Scan_failure s as e -> Printf.fprintf stderr "%s for %s\n" s date; raise e + | Invalid_argument _s as e -> Printf.fprintf stderr "Parsing %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) +let of_secs s = + let { Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours; + tm_mday=day; tm_mon=month; tm_year=year; _ } = Unix.localtime (float_of_int s) in + Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02d" + (year+1900) (month+1) day hours minutes seconds diff --git a/branches/master/lib/dune b/branches/master/lib/dune new file mode 100644 index 0000000..119bdd5 --- /dev/null +++ b/branches/master/lib/dune @@ -0,0 +1,4 @@ +(library + (name kosuzu) + (public_name kosuzu) + (libraries text_parse text_parse.parsers unix str msgpck)) diff --git a/branches/master/lib/file_store.ml b/branches/master/lib/file_store.ml new file mode 100644 index 0000000..89afa21 --- /dev/null +++ b/branches/master/lib/file_store.ml @@ -0,0 +1,150 @@ +type t = string +type item_t = t list +type record_t = Text.t * item_t + +let extension = ".txt" + +let txtdir () = try Sys.getenv "TXTDIR" with Not_found -> + let share = Filename.concat (Sys.getenv "HOME") ".local/share/texts/" in + match Sys.is_directory share with true -> share + | false | exception (Sys_error _) -> "." + +let cfgpath () = match "txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> match Filename.concat (Sys.getenv "HOME") ".config/txt/txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> "" + +let to_string f = + let ic = open_in f in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s + +let fold_file_line fn init file = match open_in file with + | 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 file path str = let o = open_out path in output_string o str; close_out o + +let to_text path = + if Filename.extension path = extension then + (to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m)) + else Error (Printf.sprintf "Not txt: %s" path) + +let newest (a,_pa) (b,_pb) = Text.newest a b +let oldest (a,_pa) (b,_pb) = Text.oldest a b + +let list_iter fn dir paths = + let link f = match to_text (Filename.concat dir f) with + | Ok t -> fn dir t f | Error s -> prerr_endline s in + List.iter link paths + +module TextMap = Map.Make(Text) + +type iteration_t = item_t TextMap.t +let new_iteration = TextMap.empty + +(*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 + +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 + +(* 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 + | f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result + | f::fs -> loop (f::result) fs + | [] -> result in + let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else + if not r then expand_dir dir else [dir] in + loop [] dirs + +let list_take n = + let rec take acc n = function [] -> [] + | x::_ when n = 1 -> x::acc + | x::xs -> take (x::acc) (n-1) xs + in take [] n + +let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist = + (match number with None -> (fun x -> x) | Some n -> list_take n) + @@ List.fast_sort comp @@ TextMap.bindings + @@ List.fold_left (fold_valid_text predicate) new_iteration flist + +let iter ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn = + let flist = list_fs ~r dir in match order with + | Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist + | None -> List.iter fn @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let fold ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn acc = + let flist = list_fs ~r dir in match order with + | Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist + | None -> List.fold_left fn acc @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let with_dir ?(descr="") ?(perm=0o740) dir = + let mkdir dir = match Unix.mkdir dir perm with + | exception Unix.Unix_error (EEXIST, _, _) -> () + | exception Unix.Unix_error (code, _fn, arg) -> + failwith @@ Printf.sprintf "Error %s making %s dir: %s" + (Unix.error_message code) descr arg + | _ -> () in + 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 rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl + +let versioned_basename_of_title ?(version=0) repo extension (title : string) = + let basename = Text.string_alias title in + let rec next version = + let candidate = Filename.concat repo + (basename ^ "." ^ string_of_int version ^ extension) in + if Sys.file_exists candidate then next (succ version) else candidate + in + next version + +let id_filename repo extension text = + let description = match Text.alias text with "" -> "" | x -> "." ^ x in + let candidate = Filename.concat repo (text.id ^ description ^ extension) in + if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate + +let with_text ?(dir=txtdir ()) new_text = + match id_filename dir extension new_text with + | Error _ as e -> e + | Ok path -> + try file path (Text.to_string new_text); Ok (path, new_text) + with Sys_error s -> Error s + +module Config = struct + type t = string Store.KV.t + let key_value k v a = Store.KV.add k (String.trim v) a +end + +let of_kv_file ?(path=cfgpath ()) () = + let open Text_parse in + let subsyntaxes = Parsers.Key_value.[| + (module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in + let of_string text acc = + Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in + if path <> "" then of_string (to_string @@ path) Store.KV.empty + else Store.KV.empty diff --git a/branches/master/lib/header_pack.ml b/branches/master/lib/header_pack.ml new file mode 100644 index 0000000..1de60e1 --- /dev/null +++ b/branches/master/lib/header_pack.ml @@ -0,0 +1,133 @@ +let version = 0 +type info_t = { version: int; id: string; title: string; people: string list; locations: string list } +type t = { info: info_t; fields: Msgpck.t; texts: Msgpck.t; peers: Msgpck.t } + +let of_id id = Msgpck.of_string id +let to_id = Msgpck.to_string + +let person p = Msgpck.String (Person.to_string p) +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 + (try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e) + +let of_set field t = + List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) [] + +let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date) + +let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x + +let fields = Msgpck.(List [ + String "id"; String "time"; String "title"; String "authors"; String "topics"; + String "references"; String "replies"; + ]) +let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack) + +let to_info = function + | Msgpck.List (v::id::n::a::ls::[]) -> + let people = to_str_list a in + 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" + +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); + List (of_set "references" t); + List (of_set "in-reply-to" 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 + | Msgpck.List (i::fields::texts::[]) -> + Ok { info = to_info i; fields; texts; peers = Msgpck.List [] } + | Msgpck.List (i::fields::texts::peers::[]) -> + Ok { info = to_info i; fields; texts; peers } + | _ -> Error "format mismatch" + +let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s + +let of_kv kv = + let find k kv = try Store.KV.find k kv with Not_found -> "" in + let find_ls k kv = try String_set.list_of_csv (Store.KV.find k kv) with Not_found -> [] in + { + info = { version = version; id = find "Id" kv; title = find "Title" kv; + people = find_ls "Authors" kv; locations = find_ls "Locations" kv }; + fields; + texts = Msgpck.List []; + peers = str_list (find_ls "Peers" kv); + } + +let list filename = try + let texts_list = function + | Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts + | _ -> prerr_endline "malformed feed"; [] in + let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in + Ok (texts_list data) + with Not_found -> Error "unspecified export dir" + +let contains text = function + | Msgpck.List (id::_time::title::_authors::_topics::[]) -> + (match to_id id with + | "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false + | id -> text.Text.id = id) + | _ -> prerr_endline ("Invalid record pattern"); false + +let numof_texts pack = List.length (Msgpck.to_list pack.texts) + +let txt_iter_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = + try begin match extra with [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end with e -> prerr_endline "iter ref reps"; raise e + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x) + +let txt_fold_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = begin match extra with + | [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i + +let iteri fn pack = List.iteri + (txt_iter_apply fn) + (Msgpck.to_list pack.texts) + +let fold fn init pack = List.fold_left + (fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init + (try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e) diff --git a/branches/master/lib/id.ml b/branches/master/lib/id.ml new file mode 100644 index 0000000..fe494d6 --- /dev/null +++ b/branches/master/lib/id.ml @@ -0,0 +1,22 @@ +let random_state = Random.State.make_self_init + +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 diff --git a/branches/master/lib/peers.ml b/branches/master/lib/peers.ml new file mode 100644 index 0000000..8b2ae69 --- /dev/null +++ b/branches/master/lib/peers.ml @@ -0,0 +1,25 @@ +let text_dir = Filename.concat (File_store.txtdir ()) "peers" + +type t = { path: string; pack: Header_pack.t } + +let fold fn init = match Sys.readdir text_dir with + | exception (Sys_error msg) -> prerr_endline msg; init + | dirs -> + let read_pack init path = + let fullpath = Filename.concat text_dir path in + if Sys.is_directory fullpath then begin + let pack_path = Filename.concat fullpath "index.pck" in + match Sys.file_exists pack_path with + | false -> Printf.eprintf "Missing index.pck for %s\n" path; init + | true -> match Header_pack.of_string (File_store.to_string pack_path) with + | Error s -> Printf.eprintf "%s %s\n" s pack_path; init + | Ok pack -> fn init { path; pack } + end else init + in + Array.fold_left read_pack init 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 diff --git a/branches/master/lib/person.ml b/branches/master/lib/person.ml new file mode 100644 index 0000000..e2f3597 --- /dev/null +++ b/branches/master/lib/person.ml @@ -0,0 +1,32 @@ +module Person = struct + type name_t = string + type address_t = string + type t = { name: name_t; addresses: address_t list } + let empty = { name = ""; addresses = [] } + let compare = Stdlib.compare + 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 -> + match Str.(split (regexp " *< *") s) with + | [] -> empty + | [n] -> let name = String.trim n in { empty with name } + | n::adds -> + let name = String.trim n in + let addresses = List.map (fun f -> String.(sub f 0 (length f -1))) adds in + { name; addresses } +end + +include Person + +module Set = struct + include Set.Make(Person) + let to_string ?(names_only=false) ?(pre="") ?(sep=", ") s = + 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 + fold j s pre + let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s)) + + let of_stringset s = String_set.fold (fun e a -> union (of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set +end diff --git a/branches/master/lib/reference_set.ml b/branches/master/lib/reference_set.ml new file mode 100644 index 0000000..6c456ec --- /dev/null +++ b/branches/master/lib/reference_set.ml @@ -0,0 +1 @@ +module Map = Map.Make(String) diff --git a/branches/master/lib/store.ml b/branches/master/lib/store.ml new file mode 100644 index 0000000..a0d435f --- /dev/null +++ b/branches/master/lib/store.ml @@ -0,0 +1,16 @@ +module KV = Map.Make (String) + +module type T = sig + type t + type item_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 + val of_path: string -> (archive_t, string) result + val newest: record_t -> record_t -> int + val oldest: record_t -> record_t -> int + val with_text: archive_t -> Text.t -> (string * Text.t, string) result + val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> (record_t -> unit) -> archive_t -> unit + val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a +end diff --git a/branches/master/lib/string_set.ml b/branches/master/lib/string_set.ml new file mode 100644 index 0000000..fca4fc1 --- /dev/null +++ b/branches/master/lib/string_set.ml @@ -0,0 +1,20 @@ +include Set.Make(String) + +let list_of_csv x = Str.(split (regexp " *, *")) (String.trim x) +let list_of_ssv x = Str.(split (regexp " +")) (String.trim x) + +let of_string ?(separator=list_of_csv) x = of_list (separator x) +let of_csv_string x = of_string ~separator:list_of_csv x +let of_ssv_string x = of_string ~separator:list_of_ssv x + +let to_string ?(pre="") ?(sep=", ") s = + let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in + fold (fun x acc -> j acc x) s pre + +let query string = + let partition (include_set, exclude_set) elt = + if String.get elt 0 = '!' then (include_set, add String.(sub elt 1 (length elt - 1)) exclude_set) + else (add elt include_set, exclude_set) in + List.fold_left partition (empty, empty) @@ list_of_csv string + +let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set diff --git a/branches/master/lib/text.ml b/branches/master/lib/text.ml new file mode 100644 index 0000000..80fb192 --- /dev/null +++ b/branches/master/lib/text.ml @@ -0,0 +1,122 @@ +module String_map = Map.Make (String) +type t = { + id: Id.t; + title: string; + authors: Person.Set.t; + date: Date.t; + string_map: string String_map.t; + stringset_map: String_set.t String_map.t; + body: string; + } + +let blank ?(id=(Id.generate ())) () = { + id; + title = ""; + authors = Person.Set.empty; + date = Date.({ created = now (); edited = ""}); + string_map = String_map.empty; + stringset_map = String_map.empty; + body = ""; + } + +let compare = Stdlib.compare +let newest a b = Date.(compare a.date b.date) +let oldest a b = Date.(compare b.date a.date) + +let str key m = + try String_map.find (String.lowercase_ascii key) m.string_map + with Not_found -> "" + +let set key m = + try String_map.find (String.lowercase_ascii key) m.stringset_map + with Not_found -> String_set.empty + +let with_str_set ?(separator=String_set.of_csv_string) m key str = + { m with + stringset_map = String_map.add (String.lowercase_ascii key) (separator str) + m.stringset_map + } + +let with_kv x (k,v) = + let trim = String.trim in + match String.lowercase_ascii k with + | "body" -> { x with body = String.trim v } + | "title"-> { x with title = trim v } + | "id" -> (match v with "" -> x | s -> { x with id = s }) + | "author" + | "authors" -> { x with authors = Person.Set.of_string (trim 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 }} + | "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v + | "references" | "in-reply-to" -> with_str_set + ~separator:(fun x -> String_set.map + (fun x -> String.(sub x 1 (length x-2))) (String_set.of_ssv_string x)) + x k v + | k -> { x with string_map = String_map.add k (trim v) x.string_map } + +let kv_of_string line = match Str.(bounded_split (regexp ": *")) line 2 with + | [ key; value ] -> Str.(replace_first (regexp "^#\\+") "" key), value + | [ key ] -> Str.(replace_first (regexp "^#\\+") "" key), "" + | _ -> "","" + +let of_header front_matter = + let fields = List.map kv_of_string (Str.(split (regexp "\n")) front_matter) in + List.fold_left with_kv (blank ~id:Id.nil ()) fields + +let front_matter_body_split s = + if Str.(string_match (regexp ".*:.*")) s 0 + then match Str.(bounded_split (regexp "^$")) s 2 with + | front::body::[] -> (front, body) + | _ -> ("", s) + else ("", s) + +let of_string s = + let front_matter, body = front_matter_body_split s in + try + let note = { (of_header front_matter) with body } in + if note.id <> Id.nil then Ok note else Error "Missing ID header" + with _ -> Error ("Failed parsing" ^ s) + +let str_set key m = String_set.to_string @@ set key m + +let to_string x = + let has_len v = String.length v > 0 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 d field value = match value with "" -> "" + | s -> field ^ ": " ^ Date.rfc_string s ^ "\n" in + let rows = [ + s "ID" x.id; + d "Date" x.date.Date.created; + d "Edited" x.date.Date.edited; + s "Title" x.title; + a x.authors; + s "Licences" (str_set "licences" x); + s "Topics" (str_set "topics" x); + s "Keywords" (str_set "keywords" x); + s "References"(str_set "references" x); (*todo: add to output <>*) + s "In-Reply-To"(str_set "in-reply-to" x); + s "Series" (str_set "series" x); + s "Abstract" (str "abstract" x); + s "Alias" (str "Alias" x) + ] in + String.concat "" rows ^ "\n" ^ x.body + +let string_alias t = + let is_reserved = function + | '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$' + | ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true + | _ -> false + in + let b = Buffer.create (String.length t) in + let filter char = + 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") + else add_char b char + in + String.(iter filter (lowercase_ascii t)); + Buffer.contents b + +let alias t = match str "alias" t with "" -> string_alias t.title | x -> x +let short_id t = Id.short t.id diff --git a/branches/master/lib/topic_set.ml b/branches/master/lib/topic_set.ml new file mode 100644 index 0000000..0e723e6 --- /dev/null +++ b/branches/master/lib/topic_set.ml @@ -0,0 +1,35 @@ +let of_string x = Str.(split (regexp " *> *")) (String.trim x) + +let topic x = + let path = of_string x in + try List.nth path (List.length path - 1) with _ -> "" + +module Map = Map.Make(String) + +let edges x map = try Map.find x map with Not_found -> (String_set.empty, String_set.empty) + +let edges_with_context context (contexts, subtopics) = (String_set.add context contexts, subtopics) +let edges_with_subtopic subtopic (contexts, subtopics) = (contexts, String_set.add subtopic subtopics) + +let rec list_to_map map = function + | [] -> map + | [topic] -> + let edges = edges topic map in + Map.add topic edges map + | context :: topic :: tail -> + let context_edges = edges context map in + let topic_edges = edges topic map in + let map = + map + |> Map.add context (edges_with_subtopic topic context_edges) + |> Map.add topic (edges_with_context context topic_edges) + in + list_to_map map (topic :: tail) + +let to_map map set = + List.fold_left (fun acc elt -> list_to_map acc (of_string elt)) map @@ String_set.elements set + +let roots map = + let root_keys acc (key, (contexts, _topics)) = if String_set.is_empty contexts then key :: acc else acc in + List.fold_left root_keys [] @@ Map.bindings map + diff --git a/branches/master/lib/validate.ml b/branches/master/lib/validate.ml new file mode 100644 index 0000000..5ee17bd --- /dev/null +++ b/branches/master/lib/validate.ml @@ -0,0 +1,5 @@ +let validate_id_length s = String.length s <= 32 +let validate_id_chars s = try + String.iter (function 'a'..'z'|'A'..'Z'|'0'..'9'-> () | _ -> raise (Invalid_argument "")) s; + true + with Invalid_argument _ -> false diff --git a/branches/origin-master/.gitignore b/branches/origin-master/.gitignore new file mode 100644 index 0000000..7281ccd --- /dev/null +++ b/branches/origin-master/.gitignore @@ -0,0 +1,12 @@ +.merlin +.logarion +*.ymd +\#*\# +.\#*1 +*~ +*.o +*.native +_build +*.htm +index.html +/.svn diff --git a/branches/origin-master/LICENSE b/branches/origin-master/LICENSE new file mode 100644 index 0000000..fa3348e --- /dev/null +++ b/branches/origin-master/LICENSE @@ -0,0 +1,153 @@ +EUROPEAN UNION PUBLIC LICENCE v. 1.2 +EUPL © the European Union 2007, 2016 + +This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such use is covered by a right of the copyright holder of the Work). + +The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following notice immediately following the copyright notice for the Work: + +Licensed under the EUPL + +or has expressed by any other means his willingness to license under the EUPL. + +1. Definitions +In this Licence, the following terms have the following meaning: + +— ‘The Licence’: this Licence. + +— ‘The Original Work’: the work or software distributed or communicated by the Licensor under this Licence, available as Source Code and also as Executable Code as the case may be. + +— ‘Derivative Works’: the works or software that could be created by the Licensee, based upon the Original Work or modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in the country mentioned in Article 15. + +— ‘The Work’: the Original Work or its Derivative Works. + +— ‘The Source Code’: the human-readable form of the Work which is the most convenient for people to study and modify. + +— ‘The Executable Code’: any code which has generally been compiled and which is meant to be interpreted by a computer as a program. + +— ‘The Licensor’: the natural or legal person that distributes or communicates the Work under the Licence. + +— ‘Contributor(s)’: any natural or legal person who modifies the Work under the Licence, or otherwise contributes to the creation of a Derivative Work. + +— ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of the Work under the terms of the Licence. + +— ‘Distribution’ or ‘Communication’: any act of selling, giving, lending, renting, distributing, communicating, transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential functionalities at the disposal of any other natural or legal person. + +2. Scope of the rights granted by the Licence +The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for the duration of copyright vested in the Original Work: + +— use the Work in any circumstance and for all usage, + +— reproduce the Work, + +— modify the Work, and make Derivative Works based upon the Work, + +— communicate to the public, including the right to make available or display the Work or copies thereof to the public and perform publicly, as the case may be, the Work, + +— distribute the Work or copies thereof, + +— lend and rent the Work or copies thereof, + +— sublicense rights in the Work or copies thereof. + +Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the applicable law permits so. + +In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed by law in order to make effective the licence of the economic rights here above listed. + +The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the extent necessary to make use of the rights granted on the Work under this Licence. + +3. Communication of the Source Code +The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to distribute or communicate the Work. + +4. Limitations on copyright +Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations thereto. + +5. Obligations of the Licensee +The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those obligations are the following: + +Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work to carry prominent notices stating that the Work has been modified and the date of modification. +Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless the Original Work is expressly distributed only under this version of the Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the Work or Derivative Work that alter or restrict the terms of the Licence. +Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. +Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available for as long as the Licensee continues to distribute or communicate the Work. +Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the copyright notice. +6. Chain of Authorship +The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contri butions to the Work, under the terms of this Licence. + +7. Disclaimer of Warranty +The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work and may therefore contain defects or ‘bugs’ inherent to this type of development. + +For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this Licence. + +This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. + +8. Disclaimer of Liability +Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. + +9. Additional agreements +While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by the fact You have accepted any warranty or additional liability. + +10. Acceptance of the Licence +The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms and conditions. + +Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution or Communication by You of the Work or copies thereof. + +11. Information to the public +In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, by offering to download the Work from a remote location) the distribution channel or media (for example, a website) must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence and the way it may be accessible, concluded, stored and reproduced by the Licensee. + +12. Termination of the Licence +The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms of the Licence. + +Such a termination will not terminate the licences of any person who has received the Work from the Licensee under the Licence, provided such persons remain in full compliance with the Licence. + +13. Miscellaneous +Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the Work. + +If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid and enforceable. + +The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. New versions of the Licence will be published with a unique version number. + +All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take advantage of the linguistic version of their choice. + +14. Jurisdiction +Without prejudice to specific agreement between parties, + +— any litigation resulting from the interpretation of this License, arising between the European Union institutions, bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, + +— any litigation arising between other parties and resulting from the interpretation of this License, will be subject to the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. + +15. Applicable Law +Without prejudice to specific agreement between parties, + +— this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, resides or has his registered office, + +— this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside a European Union Member State. + +Appendix +‘Compatible Licences’ according to Article 5 EUPL are: + +— GNU General Public License (GPL) v. 2, v. 3 + +— GNU Affero General Public License (AGPL) v. 3 + +— Open Software License (OSL) v. 2.1, v. 3.0 + +— Eclipse Public License (EPL) v. 1.0 + +— CeCILL v. 2.0, v. 2.1 + +— Mozilla Public Licence (MPL) v. 2 + +— GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 + +— Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software + +— European Union Public Licence (EUPL) v. 1.1, v. 1.2 + +— Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) + +The European Commission may update this Appendix to later versions of the above licences without producing a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the covered Source Code from exclusive appropriation. + +All other changes or additions to this Appendix require the production of a new EUPL version. diff --git a/branches/origin-master/Makefile b/branches/origin-master/Makefile new file mode 100644 index 0000000..1baf879 --- /dev/null +++ b/branches/origin-master/Makefile @@ -0,0 +1,31 @@ +OS=`uname -s` +MACHINE=`uname -m` +DATE=`date -r _build/default/cmd/txt/txt.exe +%Y%m%d` +COMMIT=`git rev-parse --short HEAD` +PREFIX=/usr/local + +CC=cc +LD=cc + +all: + @dune build +deps: + @opam install dune ocurl cmdliner msgpck +txt: + @dune build cmd/txt/txt.exe +clean: + @dune clean +dist: + @dune build + @cp _build/default/cmd/txt/txt.exe txt.exe + @strip txt.exe + @tar czvf "kosuzu-${OS}-${MACHINE}-${DATE}-${COMMIT}" txt.exe readme.txt + @rm txt.exe + +txt_init: + @dune build cmd/txt_init/txt_init.exe +install: + @dune install --prefix ${PREFIX} +uninstall: + @dune uninstall --prefix ${PREFIX} +.PHONY: txt txt_init diff --git a/branches/origin-master/README.md b/branches/origin-master/README.md new file mode 100644 index 0000000..700fb9c --- /dev/null +++ b/branches/origin-master/README.md @@ -0,0 +1,5 @@ +# Kosuzu +Text archival and exchange, named after [Kosuzu Motoori](https://en.touhouwiki.net/wiki/Kosuzu_Motoori) from [Forbidden Scrollery](https://en.touhouwiki.net/wiki/Forbidden_Scrollery). + +## Contact +* [Mailing list](mailto:kosuzu-dev@chaotic.ninja) diff --git a/branches/origin-master/TODO.md b/branches/origin-master/TODO.md new file mode 100644 index 0000000..f289c40 --- /dev/null +++ b/branches/origin-master/TODO.md @@ -0,0 +1,3 @@ +# To-do +* Support [geomyidae](gopher://bitreich.org/1/scm/geomyidae) `.gph` indexes, for now those can be generated manually somewhat +* Support tab-separated value gophermaps for any other gopher daemon diff --git a/branches/origin-master/cmd/txt/atom.ml b/branches/origin-master/cmd/txt/atom.ml new file mode 100644 index 0000000..aab1b53 --- /dev/null +++ b/branches/origin-master/cmd/txt/atom.ml @@ -0,0 +1,71 @@ +let ext = ".atom" + +let esc = Converter.Html.esc + +let element tag content = "<" ^ tag ^ ">" ^ content ^ "" + +let opt_element tag_name content = + if content <> "" + then element tag_name content + else "" + +module P = Parsers.Plain_text.Make (Converter.Html) + +let id txt = "urn:txtid:" ^ Kosuzu.(txt.Text.id) ^ "\n" +let title text = "" ^ esc text.Kosuzu.Text.title ^ "\n" + +let authors text = + let u acc addr = acc ^ element "uri" addr in + let open Kosuzu in + let fn txt a = + a ^ "" ^ (opt_element "name" @@ esc txt.Person.name) + ^ (List.fold_left u "" txt.Person.addresses) + ^ "\n" in + Person.Set.fold fn text.Text.authors "" + +let updated txt = let open Kosuzu in + ""^ Date.(txt.Text.date |> listing |> rfc_string) ^"\n" + +let htm_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let gmi_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let base_url kv protocol = try + let locs = Kosuzu.Store.KV.find "Locations" kv in + let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in + Str.(matched_string locs) + with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; "" + +let indices alternate_type c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let title = try Kosuzu.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in + let entry, fname, protocol_regexp = match alternate_type with + | "text/gemini" -> gmi_entry, "gmi.atom", "gemini" + | "text/html" | _ -> htm_entry, "feed.atom", "https?" + in + let base_url = base_url c.kv protocol_regexp in + let self = Filename.concat base_url fname in + file fname @@ (*TODO: alternate & self per url*) + {||} + ^ title ^ {|urn:txtid:|} ^ c.Conversion.id ^ "" + ^ Kosuzu.Date.now () ^ "\n" + ^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" c.texts + ^ "" + +let converter format = Conversion.{ ext; page = None; indices = Some (indices format) } diff --git a/branches/origin-master/cmd/txt/authors.ml b/branches/origin-master/cmd/txt/authors.ml new file mode 100644 index 0000000..6fd77cc --- /dev/null +++ b/branches/origin-master/cmd/txt/authors.ml @@ -0,0 +1,22 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories too") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"topics" ~doc: "Display authors who have written on topics") + +let authors_t = Term.(const authors $ recurse $ topics) + +let cmd = + let doc = "List authors" in + let man = [ + `S Manpage.s_description; + `P "List author names" ] + in + let info = Cmd.info "authors" ~doc ~man in + Cmd.v info authors_t diff --git a/branches/origin-master/cmd/txt/conversion.ml b/branches/origin-master/cmd/txt/conversion.ml new file mode 100644 index 0000000..12f74aa --- /dev/null +++ b/branches/origin-master/cmd/txt/conversion.ml @@ -0,0 +1,74 @@ +open Kosuzu + +module Rel = struct + +module Rel_set = Set.Make(String) +module Id_map = Map.Make(String) + +type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t } +type map_t = t Id_map.t + +let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty } +let empty_map = Id_map.empty + +let acc_ref date source target = Id_map.update target (function + | None -> Some { last_rel = date; + ref_set = Rel_set.singleton source; + rep_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + ref_set = Rel_set.add source rel.ref_set }) + +let acc_rep date source target = Id_map.update target (function + | None -> Some { last_rel = date; + rep_set = Rel_set.singleton source; + ref_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + rep_set = Rel_set.add source rel.rep_set }) + +let acc_txt rels (text, _paths) = + let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in + let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in + let rels = String_set.fold acc_ref (Text.set "references" text) rels in + let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in + rels + +let acc_pck rels peer = + let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in + try Header_pack.fold + (fun rels id t _title _authors _topics refs_ls reps_ls -> + let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in + let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in + rels) + rels peer.Peers.pack + with e -> prerr_endline "acc_pck"; raise e +end + + +type t = { + id: string; + dir: string; + kv: string Store.KV.t; + topic_roots: string list; + topics: (String_set.t * String_set.t) Topic_set.Map.t; + relations: Rel.map_t; + texts: Text.t list +} + +type fn_t = { + ext: string; + page: (t -> Kosuzu.Text.t -> string) option; + indices: (t -> unit) option; +} + +let empty () = { + id = ""; dir = ""; + kv = Store.KV.empty; + topic_roots = []; + topics = Topic_set.Map.empty; + relations = Rel.Id_map.empty; + texts = [] +} diff --git a/branches/origin-master/cmd/txt/convert.ml b/branches/origin-master/cmd/txt/convert.ml new file mode 100644 index 0000000..4ee7de2 --- /dev/null +++ b/branches/origin-master/cmd/txt/convert.ml @@ -0,0 +1,95 @@ +open Kosuzu + +let is_older s d = try Unix.((stat d).st_mtime < (stat s).st_mtime) with _-> true + +let convert cs r (text, files) = match Text.str "Content-Type" text with + | "" | "text/plain" -> + let source = List.hd files in + let dest = Filename.concat r.Conversion.dir (Text.short_id text) in + List.fold_left (fun a f -> + match f.Conversion.page with None -> false || a + | Some page -> + let dest = dest ^ f.Conversion.ext in + (if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations + then (File_store.file dest (page r text); true) else false) + || a) + false cs + | x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false + +let converters types kv = + let n = String.split_on_char ',' types in + let t = [] in + let t = if List.(mem "all" n || mem "htm" n) then (Html.converter kv)::t else t in + let t = if List.(mem "all" n || mem "atom" n) then (Atom.converter "text/html")::t else t in + let t = if List.(mem "all" n || mem "gmi" n) then (Gemini.converter)::t else t in + let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in + t + +let directory converters noindex repo = + let order = File_store.oldest in + let repo = + let open Conversion in + let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in + let relations = Peers.fold Rel.acc_pck rels in + { repo with relations } in + let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls, + if convert converters repo r then acc+1 else acc in + let topics, texts, count = + File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in + let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv) + with Not_found -> Topic_set.roots topics in + let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in + if not noindex then + List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters; + Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts) + +let load_kv dir = + let kv = File_store.of_kv_file () in + let idx = Filename.concat dir "index.pck" in + if not (Sys.file_exists idx) then kv else + match Header_pack.of_string @@ File_store.to_string (idx) with + | Error s -> prerr_endline s; kv + | Ok { info; peers; _ } -> + let kv = if Store.KV.mem "Id" kv then kv else Store.KV.add "Id" info.Header_pack.id kv in + let kv = if Store.KV.mem "Title" kv then kv else Store.KV.add "Title" info.Header_pack.title kv in + let kv = if Store.KV.mem "Locations" kv then kv else Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in + let kv = Store.KV.add "Peers" (String.concat ";\n" Header_pack.(to_str_list peers)) kv in + kv + +let at_path types noindex path = match path with + | "" -> prerr_endline "unspecified text file or directory" + | path when Sys.file_exists path -> + if Sys.is_directory path then ( + let kv = load_kv path in + let repo = { (Conversion.empty ()) with dir = path; kv } in + directory (converters types kv) noindex repo + ) else ( + match File_store.to_text path with + | Error s -> prerr_endline s + | Ok text -> + let dir = "." in + let open Conversion in + let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in + let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in + ignore @@ convert (converters types repo.kv) repo (text, [path]) + ) + | path -> Printf.eprintf "Path doesn't exist: %s" path + +open Cmdliner + +let path = Arg.(value & pos 0 string "" & info [] ~docv:"path" ~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)") +let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type" ~doc:"Convert to file type") +let noindex = Arg.(value & flag & info ["noindex"] ~doc:"Don't create indices in target format") + +let convert_t = Term.(const at_path $ types $ noindex $ path) + +let cmd = + let doc = "Convert texts" in + let man = [ + `S Manpage.s_description; + `P "Convert text or indexed texts within a directory to another format."; + `P "If path is a directory must contain an index.pck."; + `P "Run `txt index` first." ] + in + let info = Cmd.info "convert" ~doc ~man in + Cmd.v info convert_t diff --git a/branches/origin-master/cmd/txt/dune b/branches/origin-master/cmd/txt/dune new file mode 100644 index 0000000..471ab7f --- /dev/null +++ b/branches/origin-master/cmd/txt/dune @@ -0,0 +1,6 @@ +(executable + (name txt) + (public_name txt) + (modules txt authors convert conversion edit file index last listing + new topics html atom gemini peers pull recent unfile) + (libraries text_parse.converter text_parse.parsers kosuzu msgpck curl str cmdliner)) diff --git a/branches/origin-master/cmd/txt/edit.ml b/branches/origin-master/cmd/txt/edit.ml new file mode 100644 index 0000000..298e52c --- /dev/null +++ b/branches/origin-master/cmd/txt/edit.ml @@ -0,0 +1,22 @@ +open Cmdliner +let id = Arg.(value & pos 0 string "" & info [] ~docv: "text ID") +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts by topics") + +let edit_t = Term.(const (Kosuzu.Archive.apply_sys_util "EDITOR" "nano") $ recurse $ time $ reverse $ number $ authed $ topics $ id) + +let cmd = + let doc = "Edit a text" in + let man = [ + `S Manpage.s_description; + `P "Launches EDITOR (nano if environment variable is unset) with text path as parameter."; + `P "If -R is used, the ID search space includes texts found in subdirectories, too."; + `S Manpage.s_environment; + `P "EDITOR - Default editor name" ] + in + let info = Cmd.info "edit" ~doc ~man in + Cmd.v info edit_t diff --git a/branches/origin-master/cmd/txt/file.ml b/branches/origin-master/cmd/txt/file.ml new file mode 100644 index 0000000..cea07c8 --- /dev/null +++ b/branches/origin-master/cmd/txt/file.ml @@ -0,0 +1,23 @@ +open Kosuzu +let file files = + let dirs, files = File_store.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 + +open Cmdliner +let files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") +let file_t = Term.(const file $ files) + +let cmd = + let doc = "File texts in subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Files all texts in parameter in every directory in parameter, using hardlinks"; + `P "Use it to create sub-repositories for sharing or converting" ] + in + let info = Cmd.info "file" ~doc ~man in + Cmd.v info file_t diff --git a/branches/origin-master/cmd/txt/gemini.ml b/branches/origin-master/cmd/txt/gemini.ml new file mode 100644 index 0000000..e2136c3 --- /dev/null +++ b/branches/origin-master/cmd/txt/gemini.ml @@ -0,0 +1,100 @@ +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 Kosuzu.Text in + "# " ^ text.title + ^ "\nAuthors: " ^ Kosuzu.Person.Set.to_string text.authors + ^ "\nDate: " ^ Kosuzu.Date.(pretty_date @@ listing text.date) + ^ let module T = Parsers.Plain_text.Make (GeminiConverter) in + "\n" ^ T.of_string text.body "" + +let date_index title meta_list = + List.fold_left + (fun a m -> + a ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " ^ + Kosuzu.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n") + ("# " ^ title ^ "\n\n## Posts by date\n\n") meta_list + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list + in + List.fold_left + (fun a m -> + a + ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " + ^ Kosuzu.(Date.(pretty_date (listing m.Text.date))) ^ " " + ^ m.Kosuzu.Text.title ^ "\n") + "" meta_list + +let topic_link root topic = + 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 open Kosuzu in + "=> " ^ path ^ Text.short_id meta ^ ".gmi " + ^ Date.(pretty_date (listing meta.Text.date)) ^ " " + ^ meta.Text.title ^ "\n" + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) + and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x + in + item_group topic_roots + +let fold_topic_roots topic_roots = + let list_item root t = topic_link root t in + List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots) + +let topic_main_index r title topic_roots metas = + "# " ^ title ^ "\n\n" + ^ (if topic_roots <> [] then ("## Main topics\n\n" ^ fold_topic_roots topic_roots) else "") + ^ "\n## Latest\n\n" ^ to_dated_links ~limit:10 metas + ^ "\n=> index.date.gmi More by date\n\n" + ^ let peers = Kosuzu.Store.KV.find "Peers" r.Conversion.kv in + if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf "%s=> %s\n" a s) "## Peers\n\n" + (Str.split (Str.regexp ";\n") peers) + +let topic_sub_index title topic_map topic_root metas = + "# " ^ title ^ "\n\n" + ^ listing_index topic_map [topic_root] "" metas + +let indices r = + let open Kosuzu 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 r 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 converter = Conversion.{ ext; page = Some page; indices = Some indices} diff --git a/branches/origin-master/cmd/txt/html.ml b/branches/origin-master/cmd/txt/html.ml new file mode 100644 index 0000000..7fec0d6 --- /dev/null +++ b/branches/origin-master/cmd/txt/html.ml @@ -0,0 +1,181 @@ +type templates_t = { header: string option; footer: string option } +type t = { templates : templates_t; style : string } + +let ext = ".htm" +let empty_templates = { header = None; footer = None } +let default_opts = { templates = empty_templates; style = "" } + +let init kv = + let open Kosuzu in + let to_string key kv = match Store.KV.find key kv with + | fname -> Some (File_store.to_string fname) + | exception Not_found -> None in + let header = to_string "HTM-header" kv in + let footer = to_string "HTM-footer" kv in + let style = match to_string "HTM-style" kv with + | Some s -> Printf.sprintf "\n" s | None -> "" in + { templates = { header; footer}; style } + +let wrap conv htm text_title body = + let site_title = try Kosuzu.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in + let replace x = let open Str in + global_replace (regexp "{{archive-title}}") site_title x + |> global_replace (regexp "{{text-title}}") text_title + in + let feed = try Kosuzu.Store.KV.find "HTM-feed" conv.Conversion.kv + with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom") + then "feed.atom" else "" in + let header = match htm.templates.header with + | Some x -> replace x + | None -> Printf.(sprintf "%s%s" site_title + (if feed <> "" then sprintf "feed" feed else "")) + in + let footer = match htm.templates.footer with None -> "" | Some x -> replace x in + Printf.sprintf "\n\n\n\n%s%s\n%s\n%s\n\n\n\n\n\n%s%s%s\n" + text_title (if site_title <> "" then (" • " ^ site_title) else "") + htm.style + (if feed <> "" then Printf.sprintf "" feed else "") + header body footer + +let topic_link root topic = + let replaced_space = String.map (function ' '->'+' | x->x) in + "" + ^ String.capitalize_ascii topic ^ "" + +module HtmlConverter = struct + include Converter.Html + let uid_uri u a = Printf.sprintf "%s<%s>" a u ext u + let angled_uri u a = + if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false + then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a +end + +let page htm conversion text = + let open Kosuzu in + let open Text 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 opt_kv key value = if String.length value > 0 + then "
    " ^ key ^ "
    " ^ value else "" in + let authors = Person.Set.to_string text.authors in + let header = + let time x = Printf.sprintf {||} +(Date.rfc_string x) (Date.pretty_date x) in + let topic_links x = + let to_linked t a = + let ts = Topic_set.of_string t in + sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in + String_set.fold to_linked x "" in + let ref_links x = + let link l = HtmlConverter.uid_uri l "" in + String_set.fold (fun r a -> sep_append a (link r)) x "" in + let references, replies = let open Conversion in + let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in + ref_links ref_set, ref_links rep_set in + "
    " + ^ opt_kv "Title:" text.title + ^ opt_kv "Authors:" authors + ^ opt_kv "Date:" (time (Date.listing text.date)) + ^ opt_kv "Series:" (str_set "series" text) + ^ opt_kv "Topics:" (topic_links (set "topics" text)) + ^ opt_kv "Id:" text.id + ^ opt_kv "Refers:" (ref_links (set "references" text)) + ^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text)) + ^ opt_kv "Referred by:" references + ^ opt_kv "Replies:" replies + ^ {|
    |} in
+        wrap conversion htm text.title ((T.of_string text.body header) ^ "
    ") + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list in + List.fold_left + (fun a m -> Printf.sprintf "%s
  • %s %s" a Kosuzu.(Date.(pretty_date (listing m.Text.date))) + (Kosuzu.Text.short_id m) m.Kosuzu.Text.title) + "" meta_list + +let date_index ?(limit) conv htm meta_list = + match limit with + | Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list) + | None -> wrap conv htm "Index" (to_dated_links meta_list) + +let fold_topic_roots topic_roots = + let list_item root t = "
  • " ^ topic_link root t in + "" + +let fold_topics topic_map topic_roots metas = + let open Kosuzu in + let rec unordered_list root topic = + List.fold_left (fun a x -> a ^ list_item root x) "
      " topic + ^ "
    " + and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) +and list_item root t = + let item = + if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas + then topic_link root t else String.capitalize_ascii t in + "
    • " ^ item ^ sub_items root t ^ "
    " in + "" + +let text_item path meta = + let open Kosuzu in + " |} ^ meta.Text.title + ^ "
    " + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) +and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> {|

    |} ^ String.capitalize_ascii topic ^ "

    " ^ x in + "" + +let topic_main_index conv htm topic_roots metas = + wrap conv htm "Topics" + (fold_topic_roots topic_roots + ^ "
    More by date|} +^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in +(if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf {|%s
  • %s|} a s s) "

    Peers

      " + (Str.split (Str.regexp ";\n") (Kosuzu.Store.KV.find "Peers" conv.kv)) + ^ "
    ")) + +let topic_sub_index conv htm topic_map topic_root metas = + wrap conv htm topic_root + (fold_topics topic_map [topic_root] metas + ^ listing_index topic_map [topic_root] "" metas) + +let indices htm c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" 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 converter kv = + let htm = init kv in + Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) } diff --git a/branches/origin-master/cmd/txt/index.ml b/branches/origin-master/cmd/txt/index.ml new file mode 100644 index 0000000..a5fd2ed --- /dev/null +++ b/branches/origin-master/cmd/txt/index.ml @@ -0,0 +1,93 @@ +open Kosuzu + +let text_editor name x = + let fname, out = Filename.open_temp_file name "" in + output_string out x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let line = input_line inp in + close_in inp; line + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let text_editor_lines name x = + let fname, out = Filename.open_temp_file name "" in + List.iter (fun s -> output_string out (s ^ "\n")) x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let lines = + let rec acc a = + try let a = String.trim (input_line inp) :: a in acc a + with End_of_file -> a in + acc [] in + close_in inp; lines + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let print_pack pck = + let s ss = String.concat "\n\t" ss in + let open Header_pack in + Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n" + pck.info.id pck.info.title (String.concat "," pck.info.people) + (s pck.info.locations) (s (to_str_list pck.peers)) + +type t = { dir : string; index_path: string; pck : Header_pack.t } + +let index r print title auth locs peers = + let edit name index param = if print then index else match param with + | Some "" -> text_editor name index | Some p -> p + | None -> index in + let edits name index param = if print then index else match param with + | Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p + | None -> index in + let edits_mp name index param = if print then index else match param with + | Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index)) + | Some p -> Header_pack.str_list (String_set.list_of_csv p) + | None -> index in + let info = Header_pack.{ r.pck.info with + title = edit "Title" r.pck.info.title title; + people = edits "People" r.pck.info.people auth; + locations = edits "Locations" r.pck.info.locations locs; + } in + let pack = Header_pack.{ info; fields; + texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) []; + peers = edits_mp "Peers" r.pck.peers peers; + } in + if print then print_pack pack + else (File_store.file r.index_path (Header_pack.string pack)) + +let load dir = + let kv = File_store.of_kv_file () in + let index_path = Filename.concat dir "index.pck" in + index { dir; index_path; pck = Header_pack.of_kv kv } + +open Cmdliner +let print = Arg.(value & flag & info ["print"] ~doc: "Print info") +let title = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv: "string" ~doc: "Title for index") +let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv: "Comma-separated names" ~doc: "Index authors") +let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "location"] ~docv: "Comma-separated URLs" ~doc: "Repository URLs") +let peers = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv: "Comma-separated URLs" ~doc: "URLs to other known text repositories") +let dir = Arg.(value & pos 0 string "." & info [] ~docv: "Directory to index") + +let index_t = Term.(const load $ dir $ print $ title $ auth $ locs $ peers) + +let cmd = + let doc = "Generate an index.pck for texts in a directory" in + let man = [ + `S Manpage.s_description; + `P "An index contains:\n"; + `P "* n info section with: title for the index, the authors, locations (URLs) the texts can be accessed."; + `P "* listing of texts with: ID, date, title, authors, topics."; + `P "* list of other text repositories (peers)"; + `S Manpage.s_environment; + `P "EDITOR - Default editor name"; + `S Manpage.s_see_also; + `P "MessagePack format. https://msgpack.org" ] in + let info = Cmd.info "index" ~doc ~man in + Cmd.v info index_t diff --git a/branches/origin-master/cmd/txt/last.ml b/branches/origin-master/cmd/txt/last.ml new file mode 100644 index 0000000..b5bf31e --- /dev/null +++ b/branches/origin-master/cmd/txt/last.ml @@ -0,0 +1,35 @@ +open Kosuzu + +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' + +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' + +let last search_mine = + let filter = if search_mine then last_mine else last in + match File_store.fold filter None with + | None -> () + | Some (_, f) -> List.iter print_endline f + +open Cmdliner + +let mine = Arg.(value & flag & info ["mine"] ~doc: "Last text authored by me") +let last_t = Term.(const last $ mine) + +let cmd = + let doc = "Most recent text" in + let man = [ + `S Manpage.s_description; + `P "Print the filename of most recent text" ] + in + let info = Cmd.info "last" ~doc ~man in + Cmd.v info last_t diff --git a/branches/origin-master/cmd/txt/listing.ml b/branches/origin-master/cmd/txt/listing.ml new file mode 100644 index 0000000..fefd3a6 --- /dev/null +++ b/branches/origin-master/cmd/txt/listing.ml @@ -0,0 +1,44 @@ +open Kosuzu +module FS = File_store +module A = Archive + +let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt dir = + let dir = if dir = "" then FS.txtdir () else dir in + let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let list_text (t, fnames) = Printf.printf "%s | %s | %s | %s %s\n" + (Text.short_id t) Date.(pretty_date @@ listing t.Text.date) + (Person.Set.to_string ~names_only:true t.Text.authors) + t.Text.title (if paths_opt then (List.fold_left (Printf.sprintf "%s\n@ %s") "" fnames) else "") + in + match order_opt with + | false -> FS.iter ~r ~dir ~predicate list_text + | true -> + let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in + match number_opt with + | Some number -> FS.iter ~r ~dir ~predicate ~order ~number list_text + | None -> FS.iter ~r ~dir ~predicate ~order list_text + +open Cmdliner + +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "comma-separated topics" ~doc: "Texts by topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "directory to index") + +let listing_t = Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics $ dir) + +let cmd = + let doc = "List texts" in + let man = [ + `S Manpage.s_description; + `P "Displays text id, date, author, title for a directory."; + `P "If directory argument is omitted, TXTDIR is used, where empty value defaults to ~/.local/share/texts."; + `P "If -R is used, list header information for texts found in subdirectories, too." ] + in + let info = Cmd.info "list" ~doc ~man in + Cmd.v info listing_t diff --git a/branches/origin-master/cmd/txt/new.ml b/branches/origin-master/cmd/txt/new.ml new file mode 100644 index 0000000..73f4ebe --- /dev/null +++ b/branches/origin-master/cmd/txt/new.ml @@ -0,0 +1,29 @@ +open Kosuzu +open Cmdliner + +let new_txt title topics_opt = + let kv = Kosuzu.File_store.of_kv_file () in + let authors = Person.Set.of_string (try Kosuzu.Store.KV.find "Authors" kv + with Not_found -> Sys.getenv "USER") in + let text = { (Text.blank ()) with title; authors } in + let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _->text in + match File_store.with_text text with + | Error s -> prerr_endline s + | Ok (filepath, _note) -> + print_endline filepath + +let title = Arg.(value & pos 0 string "" & info [] ~docv: "title" ~doc: "Title for new article") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv: "Comma-separated topics" ~doc: "Topics for new article") + +let new_t = Term.(const new_txt $ title $ topics) + +let cmd = + let doc = "Create a new article" in + let man = [ + `S Manpage.s_description; + `P "Create a new article"; + `S Manpage.s_environment; + `P "USER - The login name of the user, used if the Authors field is blank" ] + in + let info = Cmd.info "new" ~doc ~man in + Cmd.v info new_t diff --git a/branches/origin-master/cmd/txt/peers.ml b/branches/origin-master/cmd/txt/peers.ml new file mode 100644 index 0000000..25753b4 --- /dev/null +++ b/branches/origin-master/cmd/txt/peers.ml @@ -0,0 +1,42 @@ +let print_peers_of_peer p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_peer () peer = + let open Kosuzu.Peers in + Printf.printf "%s" peer.path; + List.iter (Printf.printf "\t%s\n") peer.pack.info.locations + +let remove_repo id = + let repopath = Filename.concat Kosuzu.Peers.text_dir id in + match Sys.is_directory repopath with + | false -> Printf.eprintf "No repository %s in %s" id Kosuzu.Peers.text_dir + | true -> + let cmd = Printf.sprintf "rm -r %s" repopath in + Printf.printf "Run: %s ? (y/N) %!" cmd; + match input_char stdin with + |'y'-> if Sys.command cmd = 0 then print_endline "Removed" else prerr_endline "Failed" + | _ -> () + +let peers = function + | Some id -> remove_repo id + | None -> + Printf.printf "Peers in %s\n" Kosuzu.Peers.text_dir; + Kosuzu.Peers.fold print_peer () + +open Cmdliner +let remove = Arg.(value & opt (some string) None & info ["remove"] ~docv:"Repository ID" ~doc:"Remove repository texts and from future pulling") +let peers_t = Term.(const peers $ remove) + +let cmd = + let doc = "List current peers" in + let man = [ + `S Manpage.s_description; + `P "List current peers and associated information" ] + in + let info = Cmd.info "peers" ~doc ~man in + Cmd.v info peers_t diff --git a/branches/origin-master/cmd/txt/pull.ml b/branches/origin-master/cmd/txt/pull.ml new file mode 100644 index 0000000..7b5766f --- /dev/null +++ b/branches/origin-master/cmd/txt/pull.ml @@ -0,0 +1,137 @@ +let writer accum data = + Buffer.add_string accum data; + String.length data + +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; + 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 Kosuzu.File_store.to_text @@ Filename.(concat dir (Kosuzu.Id.short id) ^ ".txt") with + | Error x -> prerr_endline x; true + | Ok txt -> time > (Kosuzu.(Header_pack.date (Date.listing txt.date))) + | exception (Sys_error _) -> true + +let print_peers p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_pull_start width total title dir = + Printf.printf "%*d/%s %s => %s %!" width 0 total title dir + +let print_pull width total i = + Printf.printf "\r%*d/%s %!" width (i+1) total + +let printers total title dir = + let width = String.length total in + print_pull_start width total title dir; + print_pull width total + +let fname dir text = Filename.concat dir (Kosuzu.Text.short_id text ^ ".txt") + +let pull_text url dir id = + let u = Filename.concat url ((Kosuzu.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 Kosuzu.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 per_text url dir filter print i id time title authors topics _refs _reps = match id with + | "" -> Printf.eprintf "\nInvalid id for %s\n" title + | id -> let open Kosuzu in + print i; + if newer time id dir + && (String_set.empty = filter.topics + || String_set.exists (fun t -> List.mem t topics) filter.topics) + && (Person.Set.empty = filter.authors + || Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors) + then pull_text url dir id + +let pull_index url authors_opt topics_opt = + let index_url = Filename.concat url "index.pck" in + match curl_pull index_url with + | Error s -> prerr_endline s; false + | Ok body -> + match Kosuzu.Header_pack.of_string (Buffer.contents body) with + | Error s -> Printf.printf "Error with %s: %s\n" url s; false + | Ok pk when pk.info.id = "" -> + Printf.printf "Empty ID index.pck, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_length pk.info.id) -> + Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_chars pk.info.id) -> + Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false + | Ok pk -> + let dir = Filename.concat Kosuzu.Peers.text_dir pk.info.id in + Kosuzu.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 ( Kosuzu.Header_pack.string { + pk with info = { pk.info with locations = url::pk.info.locations }}); + close_out file; + let filter = let open Kosuzu in { + authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty); + topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty); + } in + let name = match pk.info.title with "" -> url | title -> title in + let print = printers (string_of_int @@ Kosuzu.Header_pack.numof_texts pk) name dir in + try Kosuzu.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true + with Invalid_argument msg -> Printf.printf "\nFailed to parse %s: %s\n%!" url msg; false + +let pull_list auths topics = + Curl.global_init Curl.CURLINIT_GLOBALALL; + let pull got_one peer_url = if got_one then got_one else + (pull_index peer_url auths topics) in + let open Kosuzu in + let fold_locations init peer = + ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations; + false + in + ignore @@ Peers.fold fold_locations false; + Curl.global_cleanup () + +let pull url auths topics = match url with + | "" -> pull_list auths topics | x -> ignore (pull_index x auths topics) + +open Cmdliner +let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"Comma-separated names" ~doc:"Filter by authors") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"Comma-separated topics" ~doc:"Filter by topics") +let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"Repository location") + +let pull_t = Term.(const pull $ url $ authors $ topics) + +let cmd = + let doc = "Pull listed texts" in + let man = [ + `S Manpage.s_description; + `P "Pull texts from known repositories." ] + in + let info = Cmd.info "pull" ~doc ~man in + Cmd.v info pull_t diff --git a/branches/origin-master/cmd/txt/recent.ml b/branches/origin-master/cmd/txt/recent.ml new file mode 100644 index 0000000..3b46085 --- /dev/null +++ b/branches/origin-master/cmd/txt/recent.ml @@ -0,0 +1,23 @@ +open Kosuzu +module FS = File_store +module A = Archive + +open Cmdliner +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) (Some 10) & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts with topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "Directory to index") + +let recent_t = Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics $ dir) +let cmd = + let doc = "List recent texts" in + let man = [ + `S Manpage.s_description; + `P "List header information of most recent texts."; + `P "If -R is used, list header information for texts found in subdirectories, too, along with their filepaths" ] + in + let info = Cmd.info "recent" ~doc ~man in + Cmd.v info recent_t diff --git a/branches/origin-master/cmd/txt/topics.ml b/branches/origin-master/cmd/txt/topics.ml new file mode 100644 index 0000000..9c2c936 --- /dev/null +++ b/branches/origin-master/cmd/txt/topics.ml @@ -0,0 +1,21 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated authors" ~doc: "Topics by authors") +let topics_t = Term.(const topics $ recurse $ authed) + +let cmd = + let doc = "List topics" in + let man = [ + `S Manpage.s_description; + `P "List of topics" ] + in + let info = Cmd.info "topics" ~doc ~man in + Cmd.v info topics_t diff --git a/branches/origin-master/cmd/txt/txt.ml b/branches/origin-master/cmd/txt/txt.ml new file mode 100644 index 0000000..a105d3c --- /dev/null +++ b/branches/origin-master/cmd/txt/txt.ml @@ -0,0 +1,36 @@ +open Cmdliner + +let subs = [ + Authors.cmd; + Convert.cmd; + Edit.cmd; + File.cmd; + Index.cmd; + Last.cmd; + Listing.cmd; + New.cmd; + Peers.cmd; + Pull.cmd; + Recent.cmd; + Topics.cmd; + Unfile.cmd; + ] + +let default_cmd = Term.(ret (const (`Help (`Pager, None)))) + +let txt = + let doc = "Discover, collect and exchange texts" in + let man = [ + `S Manpage.s_authors; + `P "orbifx "; + `P "Izuru Yakumo "; + `S Manpage.s_bugs; + `P "Please report them at "; + `S Manpage.s_see_also; + `P "This program is named after Kosuzu Motoori from Touhou Suzunaan: Forbidden Scrollery"; + `P "https://en.touhouwiki.net/wiki/Forbidden_Scrollery" ] + in + Cmd.group (Cmd.info "txt" ~version:"%%VERSION%%" ~doc ~man) ~default:default_cmd subs + +let main () = exit (Cmd.eval txt) +let () = main () diff --git a/branches/origin-master/cmd/txt/unfile.ml b/branches/origin-master/cmd/txt/unfile.ml new file mode 100644 index 0000000..7d29aef --- /dev/null +++ b/branches/origin-master/cmd/txt/unfile.ml @@ -0,0 +1,21 @@ +open Kosuzu + +let unfile files = + let dirs, files = File_store.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 files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") + +let unfile_t = Term.(const unfile $ files) + +let cmd = + let doc = "Unfile texts from subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Unfile texts in parameter from directories in parameter, by removing hardlinks" ] + in + let info = Cmd.info "unfile" ~doc ~man in + Cmd.v info unfile_t diff --git a/branches/origin-master/cmd/txt_init/dune b/branches/origin-master/cmd/txt_init/dune new file mode 100644 index 0000000..6090b4e --- /dev/null +++ b/branches/origin-master/cmd/txt_init/dune @@ -0,0 +1,5 @@ +(executable + (name txt_init) + (public_name txt_init) + (modules txt_init) + (libraries kosuzu)) diff --git a/branches/origin-master/cmd/txt_init/txt_init.ml b/branches/origin-master/cmd/txt_init/txt_init.ml new file mode 100644 index 0000000..30b9c53 --- /dev/null +++ b/branches/origin-master/cmd/txt_init/txt_init.ml @@ -0,0 +1,17 @@ +let init_repo = + print_endline "Initializing repository..."; + print_endline "It's required for the repository name and id."; + print_endline "Create one? (y/n)"; + match input_line stdin with + |"y"-> + let title = + print_endline "Title for repository: "; + input_line stdin in + let authors = + print_endline "Authors (format: name ): "; + input_line stdin in + Kosuzu.File_store.file "txt.conf" + (Printf.sprintf "Id:%s\nTitle: %s\nAuthors: %s\n" (Kosuzu.Id.generate ()) title authors); + Kosuzu.File_store.of_kv_file () + | _ -> + print_endline "Aborting..."; exit 1 diff --git a/branches/origin-master/dune-project b/branches/origin-master/dune-project new file mode 100644 index 0000000..6603f46 --- /dev/null +++ b/branches/origin-master/dune-project @@ -0,0 +1,16 @@ +(lang dune 2.0) +(name kosuzu) +(version 1.4.3) +(license EUPL-1.2) +(authors "orbifx ") +(bug_reports "mailto:kosuzu-dev@chaotic.ninja") +(maintainers "Izuru Yakumo ") +(homepage "https://suzunaan.chaotic.ninja/kosuzu/") +(source (uri git+https://git.chaotic.ninja/yakumo.izuru/kosuzu)) + +(generate_opam_files true) + +(package + (name kosuzu) + (synopsis "Texts archival and exchange") + (depends ocaml dune ocurl msgpck cmdliner)) diff --git a/branches/origin-master/kosuzu.opam b/branches/origin-master/kosuzu.opam new file mode 100644 index 0000000..550e165 --- /dev/null +++ b/branches/origin-master/kosuzu.opam @@ -0,0 +1,25 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "1.4.3" +synopsis: "Texts archival and exchange" +maintainer: ["Izuru Yakumo "] +authors: ["orbifx "] +license: "EUPL-1.2" +homepage: "https://suzunaan.chaotic.ninja/kosuzu/" +bug-reports: "mailto:kosuzu-dev@chaotic.ninja" +depends: ["ocaml" "dune" "ocurl" "msgpck" "cmdliner"] +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://git.chaotic.ninja/yakumo.izuru/kosuzu" diff --git a/branches/origin-master/lib/archive.ml b/branches/origin-master/lib/archive.ml new file mode 100644 index 0000000..a04d660 --- /dev/null +++ b/branches/origin-master/lib/archive.ml @@ -0,0 +1,36 @@ +let predicate fn opt = Option.(to_list @@ map fn opt) + +let authored query_string = + let q = Person.Set.of_query @@ String_set.query query_string in + fun n -> Person.Set.predicate q n.Text.authors + +let ided query_string = + let len = String.length query_string in + fun n -> + try String.sub n.Text.id 0 len = query_string + with Invalid_argument _ -> false + +let keyworded query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Keywords" n)) + +let topics query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Topics" n)) + +let apply_sys_util env def_env r order_opt reverse_opt number_opt authors_opt topics_opt id_opt = + let predicates = if id_opt <> "" then [ ided id_opt ] else [] + @ predicate authored authors_opt + @ predicate topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let util = try Sys.getenv env with Not_found -> def_env in + let print_text acc (_t, fnames) = Printf.sprintf "%s %s" acc (List.hd fnames) in + let paths = match order_opt with + | false -> File_store.fold ~r ~predicate print_text "" + | true -> + let order = match reverse_opt with true -> File_store.newest | false -> File_store.oldest in + match number_opt with + | Some number -> File_store.fold ~r ~predicate ~order ~number print_text "" + | None -> File_store.fold ~r ~predicate ~order print_text "" + in if paths = "" then () + else (ignore @@ Sys.command @@ Printf.sprintf "%s %s" util paths) diff --git a/branches/origin-master/lib/category.ml b/branches/origin-master/lib/category.ml new file mode 100644 index 0000000..ac807b6 --- /dev/null +++ b/branches/origin-master/lib/category.ml @@ -0,0 +1,22 @@ +module Category = struct + type t = Unlisted | Published | Invalid | Custom of string + let compare = Stdlib.compare + let of_string = function "unlisted" | "published" -> Invalid | c -> Custom c + let to_string = function Custom c -> c | _ -> "" +end + +include Category + +module CategorySet = struct + include Set.Make (Category) + let of_stringset s = String_set.fold (fun e a -> add (Category.of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set + let of_string x = of_stringset (String_set.of_string x) + let to_string set = + let f elt a = + let s = Category.to_string elt in + if a <> "" then a ^ ", " ^ s else s + in + fold f set "" +end diff --git a/branches/origin-master/lib/date.ml b/branches/origin-master/lib/date.ml new file mode 100644 index 0000000..6eab0d9 --- /dev/null +++ b/branches/origin-master/lib/date.ml @@ -0,0 +1,22 @@ +type t = { created: string; edited: string } +let compare = compare +let rfc_string date = date +let of_string (rfc : string) = rfc +let listing date = if date.edited <> "" then date.edited else date.created +let months = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|] +let pretty_date date = + try Scanf.sscanf date "%4s-%d-%2s" (fun y m d -> Printf.sprintf "%s %s, %s" d (months.(m-1)) y) + with + | Scanf.Scan_failure s as e -> Printf.fprintf stderr "%s for %s\n" s date; raise e + | Invalid_argument _s as e -> Printf.fprintf stderr "Parsing %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) +let of_secs s = + let { Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours; + tm_mday=day; tm_mon=month; tm_year=year; _ } = Unix.localtime (float_of_int s) in + Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02d" + (year+1900) (month+1) day hours minutes seconds diff --git a/branches/origin-master/lib/dune b/branches/origin-master/lib/dune new file mode 100644 index 0000000..119bdd5 --- /dev/null +++ b/branches/origin-master/lib/dune @@ -0,0 +1,4 @@ +(library + (name kosuzu) + (public_name kosuzu) + (libraries text_parse text_parse.parsers unix str msgpck)) diff --git a/branches/origin-master/lib/file_store.ml b/branches/origin-master/lib/file_store.ml new file mode 100644 index 0000000..89afa21 --- /dev/null +++ b/branches/origin-master/lib/file_store.ml @@ -0,0 +1,150 @@ +type t = string +type item_t = t list +type record_t = Text.t * item_t + +let extension = ".txt" + +let txtdir () = try Sys.getenv "TXTDIR" with Not_found -> + let share = Filename.concat (Sys.getenv "HOME") ".local/share/texts/" in + match Sys.is_directory share with true -> share + | false | exception (Sys_error _) -> "." + +let cfgpath () = match "txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> match Filename.concat (Sys.getenv "HOME") ".config/txt/txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> "" + +let to_string f = + let ic = open_in f in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s + +let fold_file_line fn init file = match open_in file with + | 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 file path str = let o = open_out path in output_string o str; close_out o + +let to_text path = + if Filename.extension path = extension then + (to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m)) + else Error (Printf.sprintf "Not txt: %s" path) + +let newest (a,_pa) (b,_pb) = Text.newest a b +let oldest (a,_pa) (b,_pb) = Text.oldest a b + +let list_iter fn dir paths = + let link f = match to_text (Filename.concat dir f) with + | Ok t -> fn dir t f | Error s -> prerr_endline s in + List.iter link paths + +module TextMap = Map.Make(Text) + +type iteration_t = item_t TextMap.t +let new_iteration = TextMap.empty + +(*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 + +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 + +(* 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 + | f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result + | f::fs -> loop (f::result) fs + | [] -> result in + let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else + if not r then expand_dir dir else [dir] in + loop [] dirs + +let list_take n = + let rec take acc n = function [] -> [] + | x::_ when n = 1 -> x::acc + | x::xs -> take (x::acc) (n-1) xs + in take [] n + +let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist = + (match number with None -> (fun x -> x) | Some n -> list_take n) + @@ List.fast_sort comp @@ TextMap.bindings + @@ List.fold_left (fold_valid_text predicate) new_iteration flist + +let iter ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn = + let flist = list_fs ~r dir in match order with + | Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist + | None -> List.iter fn @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let fold ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn acc = + let flist = list_fs ~r dir in match order with + | Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist + | None -> List.fold_left fn acc @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let with_dir ?(descr="") ?(perm=0o740) dir = + let mkdir dir = match Unix.mkdir dir perm with + | exception Unix.Unix_error (EEXIST, _, _) -> () + | exception Unix.Unix_error (code, _fn, arg) -> + failwith @@ Printf.sprintf "Error %s making %s dir: %s" + (Unix.error_message code) descr arg + | _ -> () in + 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 rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl + +let versioned_basename_of_title ?(version=0) repo extension (title : string) = + let basename = Text.string_alias title in + let rec next version = + let candidate = Filename.concat repo + (basename ^ "." ^ string_of_int version ^ extension) in + if Sys.file_exists candidate then next (succ version) else candidate + in + next version + +let id_filename repo extension text = + let description = match Text.alias text with "" -> "" | x -> "." ^ x in + let candidate = Filename.concat repo (text.id ^ description ^ extension) in + if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate + +let with_text ?(dir=txtdir ()) new_text = + match id_filename dir extension new_text with + | Error _ as e -> e + | Ok path -> + try file path (Text.to_string new_text); Ok (path, new_text) + with Sys_error s -> Error s + +module Config = struct + type t = string Store.KV.t + let key_value k v a = Store.KV.add k (String.trim v) a +end + +let of_kv_file ?(path=cfgpath ()) () = + let open Text_parse in + let subsyntaxes = Parsers.Key_value.[| + (module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in + let of_string text acc = + Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in + if path <> "" then of_string (to_string @@ path) Store.KV.empty + else Store.KV.empty diff --git a/branches/origin-master/lib/header_pack.ml b/branches/origin-master/lib/header_pack.ml new file mode 100644 index 0000000..1de60e1 --- /dev/null +++ b/branches/origin-master/lib/header_pack.ml @@ -0,0 +1,133 @@ +let version = 0 +type info_t = { version: int; id: string; title: string; people: string list; locations: string list } +type t = { info: info_t; fields: Msgpck.t; texts: Msgpck.t; peers: Msgpck.t } + +let of_id id = Msgpck.of_string id +let to_id = Msgpck.to_string + +let person p = Msgpck.String (Person.to_string p) +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 + (try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e) + +let of_set field t = + List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) [] + +let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date) + +let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x + +let fields = Msgpck.(List [ + String "id"; String "time"; String "title"; String "authors"; String "topics"; + String "references"; String "replies"; + ]) +let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack) + +let to_info = function + | Msgpck.List (v::id::n::a::ls::[]) -> + let people = to_str_list a in + 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" + +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); + List (of_set "references" t); + List (of_set "in-reply-to" 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 + | Msgpck.List (i::fields::texts::[]) -> + Ok { info = to_info i; fields; texts; peers = Msgpck.List [] } + | Msgpck.List (i::fields::texts::peers::[]) -> + Ok { info = to_info i; fields; texts; peers } + | _ -> Error "format mismatch" + +let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s + +let of_kv kv = + let find k kv = try Store.KV.find k kv with Not_found -> "" in + let find_ls k kv = try String_set.list_of_csv (Store.KV.find k kv) with Not_found -> [] in + { + info = { version = version; id = find "Id" kv; title = find "Title" kv; + people = find_ls "Authors" kv; locations = find_ls "Locations" kv }; + fields; + texts = Msgpck.List []; + peers = str_list (find_ls "Peers" kv); + } + +let list filename = try + let texts_list = function + | Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts + | _ -> prerr_endline "malformed feed"; [] in + let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in + Ok (texts_list data) + with Not_found -> Error "unspecified export dir" + +let contains text = function + | Msgpck.List (id::_time::title::_authors::_topics::[]) -> + (match to_id id with + | "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false + | id -> text.Text.id = id) + | _ -> prerr_endline ("Invalid record pattern"); false + +let numof_texts pack = List.length (Msgpck.to_list pack.texts) + +let txt_iter_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = + try begin match extra with [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end with e -> prerr_endline "iter ref reps"; raise e + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x) + +let txt_fold_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = begin match extra with + | [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i + +let iteri fn pack = List.iteri + (txt_iter_apply fn) + (Msgpck.to_list pack.texts) + +let fold fn init pack = List.fold_left + (fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init + (try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e) diff --git a/branches/origin-master/lib/id.ml b/branches/origin-master/lib/id.ml new file mode 100644 index 0000000..fe494d6 --- /dev/null +++ b/branches/origin-master/lib/id.ml @@ -0,0 +1,22 @@ +let random_state = Random.State.make_self_init + +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 diff --git a/branches/origin-master/lib/peers.ml b/branches/origin-master/lib/peers.ml new file mode 100644 index 0000000..8b2ae69 --- /dev/null +++ b/branches/origin-master/lib/peers.ml @@ -0,0 +1,25 @@ +let text_dir = Filename.concat (File_store.txtdir ()) "peers" + +type t = { path: string; pack: Header_pack.t } + +let fold fn init = match Sys.readdir text_dir with + | exception (Sys_error msg) -> prerr_endline msg; init + | dirs -> + let read_pack init path = + let fullpath = Filename.concat text_dir path in + if Sys.is_directory fullpath then begin + let pack_path = Filename.concat fullpath "index.pck" in + match Sys.file_exists pack_path with + | false -> Printf.eprintf "Missing index.pck for %s\n" path; init + | true -> match Header_pack.of_string (File_store.to_string pack_path) with + | Error s -> Printf.eprintf "%s %s\n" s pack_path; init + | Ok pack -> fn init { path; pack } + end else init + in + Array.fold_left read_pack init 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 diff --git a/branches/origin-master/lib/person.ml b/branches/origin-master/lib/person.ml new file mode 100644 index 0000000..e2f3597 --- /dev/null +++ b/branches/origin-master/lib/person.ml @@ -0,0 +1,32 @@ +module Person = struct + type name_t = string + type address_t = string + type t = { name: name_t; addresses: address_t list } + let empty = { name = ""; addresses = [] } + let compare = Stdlib.compare + 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 -> + match Str.(split (regexp " *< *") s) with + | [] -> empty + | [n] -> let name = String.trim n in { empty with name } + | n::adds -> + let name = String.trim n in + let addresses = List.map (fun f -> String.(sub f 0 (length f -1))) adds in + { name; addresses } +end + +include Person + +module Set = struct + include Set.Make(Person) + let to_string ?(names_only=false) ?(pre="") ?(sep=", ") s = + 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 + fold j s pre + let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s)) + + let of_stringset s = String_set.fold (fun e a -> union (of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set +end diff --git a/branches/origin-master/lib/reference_set.ml b/branches/origin-master/lib/reference_set.ml new file mode 100644 index 0000000..6c456ec --- /dev/null +++ b/branches/origin-master/lib/reference_set.ml @@ -0,0 +1 @@ +module Map = Map.Make(String) diff --git a/branches/origin-master/lib/store.ml b/branches/origin-master/lib/store.ml new file mode 100644 index 0000000..a0d435f --- /dev/null +++ b/branches/origin-master/lib/store.ml @@ -0,0 +1,16 @@ +module KV = Map.Make (String) + +module type T = sig + type t + type item_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 + val of_path: string -> (archive_t, string) result + val newest: record_t -> record_t -> int + val oldest: record_t -> record_t -> int + val with_text: archive_t -> Text.t -> (string * Text.t, string) result + val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> (record_t -> unit) -> archive_t -> unit + val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a +end diff --git a/branches/origin-master/lib/string_set.ml b/branches/origin-master/lib/string_set.ml new file mode 100644 index 0000000..fca4fc1 --- /dev/null +++ b/branches/origin-master/lib/string_set.ml @@ -0,0 +1,20 @@ +include Set.Make(String) + +let list_of_csv x = Str.(split (regexp " *, *")) (String.trim x) +let list_of_ssv x = Str.(split (regexp " +")) (String.trim x) + +let of_string ?(separator=list_of_csv) x = of_list (separator x) +let of_csv_string x = of_string ~separator:list_of_csv x +let of_ssv_string x = of_string ~separator:list_of_ssv x + +let to_string ?(pre="") ?(sep=", ") s = + let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in + fold (fun x acc -> j acc x) s pre + +let query string = + let partition (include_set, exclude_set) elt = + if String.get elt 0 = '!' then (include_set, add String.(sub elt 1 (length elt - 1)) exclude_set) + else (add elt include_set, exclude_set) in + List.fold_left partition (empty, empty) @@ list_of_csv string + +let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set diff --git a/branches/origin-master/lib/text.ml b/branches/origin-master/lib/text.ml new file mode 100644 index 0000000..80fb192 --- /dev/null +++ b/branches/origin-master/lib/text.ml @@ -0,0 +1,122 @@ +module String_map = Map.Make (String) +type t = { + id: Id.t; + title: string; + authors: Person.Set.t; + date: Date.t; + string_map: string String_map.t; + stringset_map: String_set.t String_map.t; + body: string; + } + +let blank ?(id=(Id.generate ())) () = { + id; + title = ""; + authors = Person.Set.empty; + date = Date.({ created = now (); edited = ""}); + string_map = String_map.empty; + stringset_map = String_map.empty; + body = ""; + } + +let compare = Stdlib.compare +let newest a b = Date.(compare a.date b.date) +let oldest a b = Date.(compare b.date a.date) + +let str key m = + try String_map.find (String.lowercase_ascii key) m.string_map + with Not_found -> "" + +let set key m = + try String_map.find (String.lowercase_ascii key) m.stringset_map + with Not_found -> String_set.empty + +let with_str_set ?(separator=String_set.of_csv_string) m key str = + { m with + stringset_map = String_map.add (String.lowercase_ascii key) (separator str) + m.stringset_map + } + +let with_kv x (k,v) = + let trim = String.trim in + match String.lowercase_ascii k with + | "body" -> { x with body = String.trim v } + | "title"-> { x with title = trim v } + | "id" -> (match v with "" -> x | s -> { x with id = s }) + | "author" + | "authors" -> { x with authors = Person.Set.of_string (trim 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 }} + | "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v + | "references" | "in-reply-to" -> with_str_set + ~separator:(fun x -> String_set.map + (fun x -> String.(sub x 1 (length x-2))) (String_set.of_ssv_string x)) + x k v + | k -> { x with string_map = String_map.add k (trim v) x.string_map } + +let kv_of_string line = match Str.(bounded_split (regexp ": *")) line 2 with + | [ key; value ] -> Str.(replace_first (regexp "^#\\+") "" key), value + | [ key ] -> Str.(replace_first (regexp "^#\\+") "" key), "" + | _ -> "","" + +let of_header front_matter = + let fields = List.map kv_of_string (Str.(split (regexp "\n")) front_matter) in + List.fold_left with_kv (blank ~id:Id.nil ()) fields + +let front_matter_body_split s = + if Str.(string_match (regexp ".*:.*")) s 0 + then match Str.(bounded_split (regexp "^$")) s 2 with + | front::body::[] -> (front, body) + | _ -> ("", s) + else ("", s) + +let of_string s = + let front_matter, body = front_matter_body_split s in + try + let note = { (of_header front_matter) with body } in + if note.id <> Id.nil then Ok note else Error "Missing ID header" + with _ -> Error ("Failed parsing" ^ s) + +let str_set key m = String_set.to_string @@ set key m + +let to_string x = + let has_len v = String.length v > 0 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 d field value = match value with "" -> "" + | s -> field ^ ": " ^ Date.rfc_string s ^ "\n" in + let rows = [ + s "ID" x.id; + d "Date" x.date.Date.created; + d "Edited" x.date.Date.edited; + s "Title" x.title; + a x.authors; + s "Licences" (str_set "licences" x); + s "Topics" (str_set "topics" x); + s "Keywords" (str_set "keywords" x); + s "References"(str_set "references" x); (*todo: add to output <>*) + s "In-Reply-To"(str_set "in-reply-to" x); + s "Series" (str_set "series" x); + s "Abstract" (str "abstract" x); + s "Alias" (str "Alias" x) + ] in + String.concat "" rows ^ "\n" ^ x.body + +let string_alias t = + let is_reserved = function + | '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$' + | ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true + | _ -> false + in + let b = Buffer.create (String.length t) in + let filter char = + 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") + else add_char b char + in + String.(iter filter (lowercase_ascii t)); + Buffer.contents b + +let alias t = match str "alias" t with "" -> string_alias t.title | x -> x +let short_id t = Id.short t.id diff --git a/branches/origin-master/lib/topic_set.ml b/branches/origin-master/lib/topic_set.ml new file mode 100644 index 0000000..0e723e6 --- /dev/null +++ b/branches/origin-master/lib/topic_set.ml @@ -0,0 +1,35 @@ +let of_string x = Str.(split (regexp " *> *")) (String.trim x) + +let topic x = + let path = of_string x in + try List.nth path (List.length path - 1) with _ -> "" + +module Map = Map.Make(String) + +let edges x map = try Map.find x map with Not_found -> (String_set.empty, String_set.empty) + +let edges_with_context context (contexts, subtopics) = (String_set.add context contexts, subtopics) +let edges_with_subtopic subtopic (contexts, subtopics) = (contexts, String_set.add subtopic subtopics) + +let rec list_to_map map = function + | [] -> map + | [topic] -> + let edges = edges topic map in + Map.add topic edges map + | context :: topic :: tail -> + let context_edges = edges context map in + let topic_edges = edges topic map in + let map = + map + |> Map.add context (edges_with_subtopic topic context_edges) + |> Map.add topic (edges_with_context context topic_edges) + in + list_to_map map (topic :: tail) + +let to_map map set = + List.fold_left (fun acc elt -> list_to_map acc (of_string elt)) map @@ String_set.elements set + +let roots map = + let root_keys acc (key, (contexts, _topics)) = if String_set.is_empty contexts then key :: acc else acc in + List.fold_left root_keys [] @@ Map.bindings map + diff --git a/branches/origin-master/lib/validate.ml b/branches/origin-master/lib/validate.ml new file mode 100644 index 0000000..5ee17bd --- /dev/null +++ b/branches/origin-master/lib/validate.ml @@ -0,0 +1,5 @@ +let validate_id_length s = String.length s <= 32 +let validate_id_chars s = try + String.iter (function 'a'..'z'|'A'..'Z'|'0'..'9'-> () | _ -> raise (Invalid_argument "")) s; + true + with Invalid_argument _ -> false diff --git a/branches/origin/.gitignore b/branches/origin/.gitignore new file mode 100644 index 0000000..7281ccd --- /dev/null +++ b/branches/origin/.gitignore @@ -0,0 +1,12 @@ +.merlin +.logarion +*.ymd +\#*\# +.\#*1 +*~ +*.o +*.native +_build +*.htm +index.html +/.svn diff --git a/branches/origin/LICENSE b/branches/origin/LICENSE new file mode 100644 index 0000000..fa3348e --- /dev/null +++ b/branches/origin/LICENSE @@ -0,0 +1,153 @@ +EUROPEAN UNION PUBLIC LICENCE v. 1.2 +EUPL © the European Union 2007, 2016 + +This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such use is covered by a right of the copyright holder of the Work). + +The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following notice immediately following the copyright notice for the Work: + +Licensed under the EUPL + +or has expressed by any other means his willingness to license under the EUPL. + +1. Definitions +In this Licence, the following terms have the following meaning: + +— ‘The Licence’: this Licence. + +— ‘The Original Work’: the work or software distributed or communicated by the Licensor under this Licence, available as Source Code and also as Executable Code as the case may be. + +— ‘Derivative Works’: the works or software that could be created by the Licensee, based upon the Original Work or modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in the country mentioned in Article 15. + +— ‘The Work’: the Original Work or its Derivative Works. + +— ‘The Source Code’: the human-readable form of the Work which is the most convenient for people to study and modify. + +— ‘The Executable Code’: any code which has generally been compiled and which is meant to be interpreted by a computer as a program. + +— ‘The Licensor’: the natural or legal person that distributes or communicates the Work under the Licence. + +— ‘Contributor(s)’: any natural or legal person who modifies the Work under the Licence, or otherwise contributes to the creation of a Derivative Work. + +— ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of the Work under the terms of the Licence. + +— ‘Distribution’ or ‘Communication’: any act of selling, giving, lending, renting, distributing, communicating, transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential functionalities at the disposal of any other natural or legal person. + +2. Scope of the rights granted by the Licence +The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for the duration of copyright vested in the Original Work: + +— use the Work in any circumstance and for all usage, + +— reproduce the Work, + +— modify the Work, and make Derivative Works based upon the Work, + +— communicate to the public, including the right to make available or display the Work or copies thereof to the public and perform publicly, as the case may be, the Work, + +— distribute the Work or copies thereof, + +— lend and rent the Work or copies thereof, + +— sublicense rights in the Work or copies thereof. + +Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the applicable law permits so. + +In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed by law in order to make effective the licence of the economic rights here above listed. + +The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the extent necessary to make use of the rights granted on the Work under this Licence. + +3. Communication of the Source Code +The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to distribute or communicate the Work. + +4. Limitations on copyright +Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations thereto. + +5. Obligations of the Licensee +The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those obligations are the following: + +Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work to carry prominent notices stating that the Work has been modified and the date of modification. +Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless the Original Work is expressly distributed only under this version of the Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the Work or Derivative Work that alter or restrict the terms of the Licence. +Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. +Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available for as long as the Licensee continues to distribute or communicate the Work. +Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the copyright notice. +6. Chain of Authorship +The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contri butions to the Work, under the terms of this Licence. + +7. Disclaimer of Warranty +The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work and may therefore contain defects or ‘bugs’ inherent to this type of development. + +For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this Licence. + +This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. + +8. Disclaimer of Liability +Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. + +9. Additional agreements +While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by the fact You have accepted any warranty or additional liability. + +10. Acceptance of the Licence +The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms and conditions. + +Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution or Communication by You of the Work or copies thereof. + +11. Information to the public +In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, by offering to download the Work from a remote location) the distribution channel or media (for example, a website) must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence and the way it may be accessible, concluded, stored and reproduced by the Licensee. + +12. Termination of the Licence +The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms of the Licence. + +Such a termination will not terminate the licences of any person who has received the Work from the Licensee under the Licence, provided such persons remain in full compliance with the Licence. + +13. Miscellaneous +Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the Work. + +If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid and enforceable. + +The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. New versions of the Licence will be published with a unique version number. + +All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take advantage of the linguistic version of their choice. + +14. Jurisdiction +Without prejudice to specific agreement between parties, + +— any litigation resulting from the interpretation of this License, arising between the European Union institutions, bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, + +— any litigation arising between other parties and resulting from the interpretation of this License, will be subject to the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. + +15. Applicable Law +Without prejudice to specific agreement between parties, + +— this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, resides or has his registered office, + +— this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside a European Union Member State. + +Appendix +‘Compatible Licences’ according to Article 5 EUPL are: + +— GNU General Public License (GPL) v. 2, v. 3 + +— GNU Affero General Public License (AGPL) v. 3 + +— Open Software License (OSL) v. 2.1, v. 3.0 + +— Eclipse Public License (EPL) v. 1.0 + +— CeCILL v. 2.0, v. 2.1 + +— Mozilla Public Licence (MPL) v. 2 + +— GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 + +— Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software + +— European Union Public Licence (EUPL) v. 1.1, v. 1.2 + +— Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) + +The European Commission may update this Appendix to later versions of the above licences without producing a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the covered Source Code from exclusive appropriation. + +All other changes or additions to this Appendix require the production of a new EUPL version. diff --git a/branches/origin/Makefile b/branches/origin/Makefile new file mode 100644 index 0000000..1baf879 --- /dev/null +++ b/branches/origin/Makefile @@ -0,0 +1,31 @@ +OS=`uname -s` +MACHINE=`uname -m` +DATE=`date -r _build/default/cmd/txt/txt.exe +%Y%m%d` +COMMIT=`git rev-parse --short HEAD` +PREFIX=/usr/local + +CC=cc +LD=cc + +all: + @dune build +deps: + @opam install dune ocurl cmdliner msgpck +txt: + @dune build cmd/txt/txt.exe +clean: + @dune clean +dist: + @dune build + @cp _build/default/cmd/txt/txt.exe txt.exe + @strip txt.exe + @tar czvf "kosuzu-${OS}-${MACHINE}-${DATE}-${COMMIT}" txt.exe readme.txt + @rm txt.exe + +txt_init: + @dune build cmd/txt_init/txt_init.exe +install: + @dune install --prefix ${PREFIX} +uninstall: + @dune uninstall --prefix ${PREFIX} +.PHONY: txt txt_init diff --git a/branches/origin/README.md b/branches/origin/README.md new file mode 100644 index 0000000..700fb9c --- /dev/null +++ b/branches/origin/README.md @@ -0,0 +1,5 @@ +# Kosuzu +Text archival and exchange, named after [Kosuzu Motoori](https://en.touhouwiki.net/wiki/Kosuzu_Motoori) from [Forbidden Scrollery](https://en.touhouwiki.net/wiki/Forbidden_Scrollery). + +## Contact +* [Mailing list](mailto:kosuzu-dev@chaotic.ninja) diff --git a/branches/origin/TODO.md b/branches/origin/TODO.md new file mode 100644 index 0000000..f289c40 --- /dev/null +++ b/branches/origin/TODO.md @@ -0,0 +1,3 @@ +# To-do +* Support [geomyidae](gopher://bitreich.org/1/scm/geomyidae) `.gph` indexes, for now those can be generated manually somewhat +* Support tab-separated value gophermaps for any other gopher daemon diff --git a/branches/origin/cmd/txt/atom.ml b/branches/origin/cmd/txt/atom.ml new file mode 100644 index 0000000..aab1b53 --- /dev/null +++ b/branches/origin/cmd/txt/atom.ml @@ -0,0 +1,71 @@ +let ext = ".atom" + +let esc = Converter.Html.esc + +let element tag content = "<" ^ tag ^ ">" ^ content ^ "" + +let opt_element tag_name content = + if content <> "" + then element tag_name content + else "" + +module P = Parsers.Plain_text.Make (Converter.Html) + +let id txt = "urn:txtid:" ^ Kosuzu.(txt.Text.id) ^ "\n" +let title text = "" ^ esc text.Kosuzu.Text.title ^ "\n" + +let authors text = + let u acc addr = acc ^ element "uri" addr in + let open Kosuzu in + let fn txt a = + a ^ "" ^ (opt_element "name" @@ esc txt.Person.name) + ^ (List.fold_left u "" txt.Person.addresses) + ^ "\n" in + Person.Set.fold fn text.Text.authors "" + +let updated txt = let open Kosuzu in + ""^ Date.(txt.Text.date |> listing |> rfc_string) ^"\n" + +let htm_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let gmi_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let base_url kv protocol = try + let locs = Kosuzu.Store.KV.find "Locations" kv in + let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in + Str.(matched_string locs) + with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; "" + +let indices alternate_type c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let title = try Kosuzu.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in + let entry, fname, protocol_regexp = match alternate_type with + | "text/gemini" -> gmi_entry, "gmi.atom", "gemini" + | "text/html" | _ -> htm_entry, "feed.atom", "https?" + in + let base_url = base_url c.kv protocol_regexp in + let self = Filename.concat base_url fname in + file fname @@ (*TODO: alternate & self per url*) + {||} + ^ title ^ {|urn:txtid:|} ^ c.Conversion.id ^ "" + ^ Kosuzu.Date.now () ^ "\n" + ^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" c.texts + ^ "" + +let converter format = Conversion.{ ext; page = None; indices = Some (indices format) } diff --git a/branches/origin/cmd/txt/authors.ml b/branches/origin/cmd/txt/authors.ml new file mode 100644 index 0000000..6fd77cc --- /dev/null +++ b/branches/origin/cmd/txt/authors.ml @@ -0,0 +1,22 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories too") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"topics" ~doc: "Display authors who have written on topics") + +let authors_t = Term.(const authors $ recurse $ topics) + +let cmd = + let doc = "List authors" in + let man = [ + `S Manpage.s_description; + `P "List author names" ] + in + let info = Cmd.info "authors" ~doc ~man in + Cmd.v info authors_t diff --git a/branches/origin/cmd/txt/conversion.ml b/branches/origin/cmd/txt/conversion.ml new file mode 100644 index 0000000..12f74aa --- /dev/null +++ b/branches/origin/cmd/txt/conversion.ml @@ -0,0 +1,74 @@ +open Kosuzu + +module Rel = struct + +module Rel_set = Set.Make(String) +module Id_map = Map.Make(String) + +type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t } +type map_t = t Id_map.t + +let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty } +let empty_map = Id_map.empty + +let acc_ref date source target = Id_map.update target (function + | None -> Some { last_rel = date; + ref_set = Rel_set.singleton source; + rep_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + ref_set = Rel_set.add source rel.ref_set }) + +let acc_rep date source target = Id_map.update target (function + | None -> Some { last_rel = date; + rep_set = Rel_set.singleton source; + ref_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + rep_set = Rel_set.add source rel.rep_set }) + +let acc_txt rels (text, _paths) = + let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in + let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in + let rels = String_set.fold acc_ref (Text.set "references" text) rels in + let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in + rels + +let acc_pck rels peer = + let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in + try Header_pack.fold + (fun rels id t _title _authors _topics refs_ls reps_ls -> + let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in + let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in + rels) + rels peer.Peers.pack + with e -> prerr_endline "acc_pck"; raise e +end + + +type t = { + id: string; + dir: string; + kv: string Store.KV.t; + topic_roots: string list; + topics: (String_set.t * String_set.t) Topic_set.Map.t; + relations: Rel.map_t; + texts: Text.t list +} + +type fn_t = { + ext: string; + page: (t -> Kosuzu.Text.t -> string) option; + indices: (t -> unit) option; +} + +let empty () = { + id = ""; dir = ""; + kv = Store.KV.empty; + topic_roots = []; + topics = Topic_set.Map.empty; + relations = Rel.Id_map.empty; + texts = [] +} diff --git a/branches/origin/cmd/txt/convert.ml b/branches/origin/cmd/txt/convert.ml new file mode 100644 index 0000000..4ee7de2 --- /dev/null +++ b/branches/origin/cmd/txt/convert.ml @@ -0,0 +1,95 @@ +open Kosuzu + +let is_older s d = try Unix.((stat d).st_mtime < (stat s).st_mtime) with _-> true + +let convert cs r (text, files) = match Text.str "Content-Type" text with + | "" | "text/plain" -> + let source = List.hd files in + let dest = Filename.concat r.Conversion.dir (Text.short_id text) in + List.fold_left (fun a f -> + match f.Conversion.page with None -> false || a + | Some page -> + let dest = dest ^ f.Conversion.ext in + (if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations + then (File_store.file dest (page r text); true) else false) + || a) + false cs + | x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false + +let converters types kv = + let n = String.split_on_char ',' types in + let t = [] in + let t = if List.(mem "all" n || mem "htm" n) then (Html.converter kv)::t else t in + let t = if List.(mem "all" n || mem "atom" n) then (Atom.converter "text/html")::t else t in + let t = if List.(mem "all" n || mem "gmi" n) then (Gemini.converter)::t else t in + let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in + t + +let directory converters noindex repo = + let order = File_store.oldest in + let repo = + let open Conversion in + let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in + let relations = Peers.fold Rel.acc_pck rels in + { repo with relations } in + let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls, + if convert converters repo r then acc+1 else acc in + let topics, texts, count = + File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in + let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv) + with Not_found -> Topic_set.roots topics in + let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in + if not noindex then + List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters; + Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts) + +let load_kv dir = + let kv = File_store.of_kv_file () in + let idx = Filename.concat dir "index.pck" in + if not (Sys.file_exists idx) then kv else + match Header_pack.of_string @@ File_store.to_string (idx) with + | Error s -> prerr_endline s; kv + | Ok { info; peers; _ } -> + let kv = if Store.KV.mem "Id" kv then kv else Store.KV.add "Id" info.Header_pack.id kv in + let kv = if Store.KV.mem "Title" kv then kv else Store.KV.add "Title" info.Header_pack.title kv in + let kv = if Store.KV.mem "Locations" kv then kv else Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in + let kv = Store.KV.add "Peers" (String.concat ";\n" Header_pack.(to_str_list peers)) kv in + kv + +let at_path types noindex path = match path with + | "" -> prerr_endline "unspecified text file or directory" + | path when Sys.file_exists path -> + if Sys.is_directory path then ( + let kv = load_kv path in + let repo = { (Conversion.empty ()) with dir = path; kv } in + directory (converters types kv) noindex repo + ) else ( + match File_store.to_text path with + | Error s -> prerr_endline s + | Ok text -> + let dir = "." in + let open Conversion in + let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in + let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in + ignore @@ convert (converters types repo.kv) repo (text, [path]) + ) + | path -> Printf.eprintf "Path doesn't exist: %s" path + +open Cmdliner + +let path = Arg.(value & pos 0 string "" & info [] ~docv:"path" ~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)") +let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type" ~doc:"Convert to file type") +let noindex = Arg.(value & flag & info ["noindex"] ~doc:"Don't create indices in target format") + +let convert_t = Term.(const at_path $ types $ noindex $ path) + +let cmd = + let doc = "Convert texts" in + let man = [ + `S Manpage.s_description; + `P "Convert text or indexed texts within a directory to another format."; + `P "If path is a directory must contain an index.pck."; + `P "Run `txt index` first." ] + in + let info = Cmd.info "convert" ~doc ~man in + Cmd.v info convert_t diff --git a/branches/origin/cmd/txt/dune b/branches/origin/cmd/txt/dune new file mode 100644 index 0000000..471ab7f --- /dev/null +++ b/branches/origin/cmd/txt/dune @@ -0,0 +1,6 @@ +(executable + (name txt) + (public_name txt) + (modules txt authors convert conversion edit file index last listing + new topics html atom gemini peers pull recent unfile) + (libraries text_parse.converter text_parse.parsers kosuzu msgpck curl str cmdliner)) diff --git a/branches/origin/cmd/txt/edit.ml b/branches/origin/cmd/txt/edit.ml new file mode 100644 index 0000000..298e52c --- /dev/null +++ b/branches/origin/cmd/txt/edit.ml @@ -0,0 +1,22 @@ +open Cmdliner +let id = Arg.(value & pos 0 string "" & info [] ~docv: "text ID") +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts by topics") + +let edit_t = Term.(const (Kosuzu.Archive.apply_sys_util "EDITOR" "nano") $ recurse $ time $ reverse $ number $ authed $ topics $ id) + +let cmd = + let doc = "Edit a text" in + let man = [ + `S Manpage.s_description; + `P "Launches EDITOR (nano if environment variable is unset) with text path as parameter."; + `P "If -R is used, the ID search space includes texts found in subdirectories, too."; + `S Manpage.s_environment; + `P "EDITOR - Default editor name" ] + in + let info = Cmd.info "edit" ~doc ~man in + Cmd.v info edit_t diff --git a/branches/origin/cmd/txt/file.ml b/branches/origin/cmd/txt/file.ml new file mode 100644 index 0000000..cea07c8 --- /dev/null +++ b/branches/origin/cmd/txt/file.ml @@ -0,0 +1,23 @@ +open Kosuzu +let file files = + let dirs, files = File_store.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 + +open Cmdliner +let files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") +let file_t = Term.(const file $ files) + +let cmd = + let doc = "File texts in subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Files all texts in parameter in every directory in parameter, using hardlinks"; + `P "Use it to create sub-repositories for sharing or converting" ] + in + let info = Cmd.info "file" ~doc ~man in + Cmd.v info file_t diff --git a/branches/origin/cmd/txt/gemini.ml b/branches/origin/cmd/txt/gemini.ml new file mode 100644 index 0000000..e2136c3 --- /dev/null +++ b/branches/origin/cmd/txt/gemini.ml @@ -0,0 +1,100 @@ +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 Kosuzu.Text in + "# " ^ text.title + ^ "\nAuthors: " ^ Kosuzu.Person.Set.to_string text.authors + ^ "\nDate: " ^ Kosuzu.Date.(pretty_date @@ listing text.date) + ^ let module T = Parsers.Plain_text.Make (GeminiConverter) in + "\n" ^ T.of_string text.body "" + +let date_index title meta_list = + List.fold_left + (fun a m -> + a ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " ^ + Kosuzu.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n") + ("# " ^ title ^ "\n\n## Posts by date\n\n") meta_list + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list + in + List.fold_left + (fun a m -> + a + ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " + ^ Kosuzu.(Date.(pretty_date (listing m.Text.date))) ^ " " + ^ m.Kosuzu.Text.title ^ "\n") + "" meta_list + +let topic_link root topic = + 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 open Kosuzu in + "=> " ^ path ^ Text.short_id meta ^ ".gmi " + ^ Date.(pretty_date (listing meta.Text.date)) ^ " " + ^ meta.Text.title ^ "\n" + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) + and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x + in + item_group topic_roots + +let fold_topic_roots topic_roots = + let list_item root t = topic_link root t in + List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots) + +let topic_main_index r title topic_roots metas = + "# " ^ title ^ "\n\n" + ^ (if topic_roots <> [] then ("## Main topics\n\n" ^ fold_topic_roots topic_roots) else "") + ^ "\n## Latest\n\n" ^ to_dated_links ~limit:10 metas + ^ "\n=> index.date.gmi More by date\n\n" + ^ let peers = Kosuzu.Store.KV.find "Peers" r.Conversion.kv in + if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf "%s=> %s\n" a s) "## Peers\n\n" + (Str.split (Str.regexp ";\n") peers) + +let topic_sub_index title topic_map topic_root metas = + "# " ^ title ^ "\n\n" + ^ listing_index topic_map [topic_root] "" metas + +let indices r = + let open Kosuzu 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 r 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 converter = Conversion.{ ext; page = Some page; indices = Some indices} diff --git a/branches/origin/cmd/txt/html.ml b/branches/origin/cmd/txt/html.ml new file mode 100644 index 0000000..7fec0d6 --- /dev/null +++ b/branches/origin/cmd/txt/html.ml @@ -0,0 +1,181 @@ +type templates_t = { header: string option; footer: string option } +type t = { templates : templates_t; style : string } + +let ext = ".htm" +let empty_templates = { header = None; footer = None } +let default_opts = { templates = empty_templates; style = "" } + +let init kv = + let open Kosuzu in + let to_string key kv = match Store.KV.find key kv with + | fname -> Some (File_store.to_string fname) + | exception Not_found -> None in + let header = to_string "HTM-header" kv in + let footer = to_string "HTM-footer" kv in + let style = match to_string "HTM-style" kv with + | Some s -> Printf.sprintf "\n" s | None -> "" in + { templates = { header; footer}; style } + +let wrap conv htm text_title body = + let site_title = try Kosuzu.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in + let replace x = let open Str in + global_replace (regexp "{{archive-title}}") site_title x + |> global_replace (regexp "{{text-title}}") text_title + in + let feed = try Kosuzu.Store.KV.find "HTM-feed" conv.Conversion.kv + with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom") + then "feed.atom" else "" in + let header = match htm.templates.header with + | Some x -> replace x + | None -> Printf.(sprintf "%s%s" site_title + (if feed <> "" then sprintf "feed" feed else "")) + in + let footer = match htm.templates.footer with None -> "" | Some x -> replace x in + Printf.sprintf "\n\n\n\n%s%s\n%s\n%s\n\n\n\n\n\n%s%s%s\n" + text_title (if site_title <> "" then (" • " ^ site_title) else "") + htm.style + (if feed <> "" then Printf.sprintf "" feed else "") + header body footer + +let topic_link root topic = + let replaced_space = String.map (function ' '->'+' | x->x) in + "" + ^ String.capitalize_ascii topic ^ "" + +module HtmlConverter = struct + include Converter.Html + let uid_uri u a = Printf.sprintf "%s<%s>" a u ext u + let angled_uri u a = + if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false + then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a +end + +let page htm conversion text = + let open Kosuzu in + let open Text 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 opt_kv key value = if String.length value > 0 + then "
    " ^ key ^ "
    " ^ value else "" in + let authors = Person.Set.to_string text.authors in + let header = + let time x = Printf.sprintf {||} +(Date.rfc_string x) (Date.pretty_date x) in + let topic_links x = + let to_linked t a = + let ts = Topic_set.of_string t in + sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in + String_set.fold to_linked x "" in + let ref_links x = + let link l = HtmlConverter.uid_uri l "" in + String_set.fold (fun r a -> sep_append a (link r)) x "" in + let references, replies = let open Conversion in + let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in + ref_links ref_set, ref_links rep_set in + "
    " + ^ opt_kv "Title:" text.title + ^ opt_kv "Authors:" authors + ^ opt_kv "Date:" (time (Date.listing text.date)) + ^ opt_kv "Series:" (str_set "series" text) + ^ opt_kv "Topics:" (topic_links (set "topics" text)) + ^ opt_kv "Id:" text.id + ^ opt_kv "Refers:" (ref_links (set "references" text)) + ^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text)) + ^ opt_kv "Referred by:" references + ^ opt_kv "Replies:" replies + ^ {|
    |} in
+        wrap conversion htm text.title ((T.of_string text.body header) ^ "
    ") + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list in + List.fold_left + (fun a m -> Printf.sprintf "%s
  • %s %s" a Kosuzu.(Date.(pretty_date (listing m.Text.date))) + (Kosuzu.Text.short_id m) m.Kosuzu.Text.title) + "" meta_list + +let date_index ?(limit) conv htm meta_list = + match limit with + | Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list) + | None -> wrap conv htm "Index" (to_dated_links meta_list) + +let fold_topic_roots topic_roots = + let list_item root t = "
  • " ^ topic_link root t in + "" + +let fold_topics topic_map topic_roots metas = + let open Kosuzu in + let rec unordered_list root topic = + List.fold_left (fun a x -> a ^ list_item root x) "
      " topic + ^ "
    " + and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) +and list_item root t = + let item = + if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas + then topic_link root t else String.capitalize_ascii t in + "
    • " ^ item ^ sub_items root t ^ "
    " in + "" + +let text_item path meta = + let open Kosuzu in + " |} ^ meta.Text.title + ^ "
    " + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) +and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> {|

    |} ^ String.capitalize_ascii topic ^ "

    " ^ x in + "" + +let topic_main_index conv htm topic_roots metas = + wrap conv htm "Topics" + (fold_topic_roots topic_roots + ^ "
    More by date|} +^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in +(if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf {|%s
  • %s|} a s s) "

    Peers

      " + (Str.split (Str.regexp ";\n") (Kosuzu.Store.KV.find "Peers" conv.kv)) + ^ "
    ")) + +let topic_sub_index conv htm topic_map topic_root metas = + wrap conv htm topic_root + (fold_topics topic_map [topic_root] metas + ^ listing_index topic_map [topic_root] "" metas) + +let indices htm c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" 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 converter kv = + let htm = init kv in + Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) } diff --git a/branches/origin/cmd/txt/index.ml b/branches/origin/cmd/txt/index.ml new file mode 100644 index 0000000..a5fd2ed --- /dev/null +++ b/branches/origin/cmd/txt/index.ml @@ -0,0 +1,93 @@ +open Kosuzu + +let text_editor name x = + let fname, out = Filename.open_temp_file name "" in + output_string out x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let line = input_line inp in + close_in inp; line + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let text_editor_lines name x = + let fname, out = Filename.open_temp_file name "" in + List.iter (fun s -> output_string out (s ^ "\n")) x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let lines = + let rec acc a = + try let a = String.trim (input_line inp) :: a in acc a + with End_of_file -> a in + acc [] in + close_in inp; lines + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let print_pack pck = + let s ss = String.concat "\n\t" ss in + let open Header_pack in + Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n" + pck.info.id pck.info.title (String.concat "," pck.info.people) + (s pck.info.locations) (s (to_str_list pck.peers)) + +type t = { dir : string; index_path: string; pck : Header_pack.t } + +let index r print title auth locs peers = + let edit name index param = if print then index else match param with + | Some "" -> text_editor name index | Some p -> p + | None -> index in + let edits name index param = if print then index else match param with + | Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p + | None -> index in + let edits_mp name index param = if print then index else match param with + | Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index)) + | Some p -> Header_pack.str_list (String_set.list_of_csv p) + | None -> index in + let info = Header_pack.{ r.pck.info with + title = edit "Title" r.pck.info.title title; + people = edits "People" r.pck.info.people auth; + locations = edits "Locations" r.pck.info.locations locs; + } in + let pack = Header_pack.{ info; fields; + texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) []; + peers = edits_mp "Peers" r.pck.peers peers; + } in + if print then print_pack pack + else (File_store.file r.index_path (Header_pack.string pack)) + +let load dir = + let kv = File_store.of_kv_file () in + let index_path = Filename.concat dir "index.pck" in + index { dir; index_path; pck = Header_pack.of_kv kv } + +open Cmdliner +let print = Arg.(value & flag & info ["print"] ~doc: "Print info") +let title = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv: "string" ~doc: "Title for index") +let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv: "Comma-separated names" ~doc: "Index authors") +let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "location"] ~docv: "Comma-separated URLs" ~doc: "Repository URLs") +let peers = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv: "Comma-separated URLs" ~doc: "URLs to other known text repositories") +let dir = Arg.(value & pos 0 string "." & info [] ~docv: "Directory to index") + +let index_t = Term.(const load $ dir $ print $ title $ auth $ locs $ peers) + +let cmd = + let doc = "Generate an index.pck for texts in a directory" in + let man = [ + `S Manpage.s_description; + `P "An index contains:\n"; + `P "* n info section with: title for the index, the authors, locations (URLs) the texts can be accessed."; + `P "* listing of texts with: ID, date, title, authors, topics."; + `P "* list of other text repositories (peers)"; + `S Manpage.s_environment; + `P "EDITOR - Default editor name"; + `S Manpage.s_see_also; + `P "MessagePack format. https://msgpack.org" ] in + let info = Cmd.info "index" ~doc ~man in + Cmd.v info index_t diff --git a/branches/origin/cmd/txt/last.ml b/branches/origin/cmd/txt/last.ml new file mode 100644 index 0000000..b5bf31e --- /dev/null +++ b/branches/origin/cmd/txt/last.ml @@ -0,0 +1,35 @@ +open Kosuzu + +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' + +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' + +let last search_mine = + let filter = if search_mine then last_mine else last in + match File_store.fold filter None with + | None -> () + | Some (_, f) -> List.iter print_endline f + +open Cmdliner + +let mine = Arg.(value & flag & info ["mine"] ~doc: "Last text authored by me") +let last_t = Term.(const last $ mine) + +let cmd = + let doc = "Most recent text" in + let man = [ + `S Manpage.s_description; + `P "Print the filename of most recent text" ] + in + let info = Cmd.info "last" ~doc ~man in + Cmd.v info last_t diff --git a/branches/origin/cmd/txt/listing.ml b/branches/origin/cmd/txt/listing.ml new file mode 100644 index 0000000..fefd3a6 --- /dev/null +++ b/branches/origin/cmd/txt/listing.ml @@ -0,0 +1,44 @@ +open Kosuzu +module FS = File_store +module A = Archive + +let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt dir = + let dir = if dir = "" then FS.txtdir () else dir in + let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let list_text (t, fnames) = Printf.printf "%s | %s | %s | %s %s\n" + (Text.short_id t) Date.(pretty_date @@ listing t.Text.date) + (Person.Set.to_string ~names_only:true t.Text.authors) + t.Text.title (if paths_opt then (List.fold_left (Printf.sprintf "%s\n@ %s") "" fnames) else "") + in + match order_opt with + | false -> FS.iter ~r ~dir ~predicate list_text + | true -> + let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in + match number_opt with + | Some number -> FS.iter ~r ~dir ~predicate ~order ~number list_text + | None -> FS.iter ~r ~dir ~predicate ~order list_text + +open Cmdliner + +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "comma-separated topics" ~doc: "Texts by topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "directory to index") + +let listing_t = Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics $ dir) + +let cmd = + let doc = "List texts" in + let man = [ + `S Manpage.s_description; + `P "Displays text id, date, author, title for a directory."; + `P "If directory argument is omitted, TXTDIR is used, where empty value defaults to ~/.local/share/texts."; + `P "If -R is used, list header information for texts found in subdirectories, too." ] + in + let info = Cmd.info "list" ~doc ~man in + Cmd.v info listing_t diff --git a/branches/origin/cmd/txt/new.ml b/branches/origin/cmd/txt/new.ml new file mode 100644 index 0000000..73f4ebe --- /dev/null +++ b/branches/origin/cmd/txt/new.ml @@ -0,0 +1,29 @@ +open Kosuzu +open Cmdliner + +let new_txt title topics_opt = + let kv = Kosuzu.File_store.of_kv_file () in + let authors = Person.Set.of_string (try Kosuzu.Store.KV.find "Authors" kv + with Not_found -> Sys.getenv "USER") in + let text = { (Text.blank ()) with title; authors } in + let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _->text in + match File_store.with_text text with + | Error s -> prerr_endline s + | Ok (filepath, _note) -> + print_endline filepath + +let title = Arg.(value & pos 0 string "" & info [] ~docv: "title" ~doc: "Title for new article") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv: "Comma-separated topics" ~doc: "Topics for new article") + +let new_t = Term.(const new_txt $ title $ topics) + +let cmd = + let doc = "Create a new article" in + let man = [ + `S Manpage.s_description; + `P "Create a new article"; + `S Manpage.s_environment; + `P "USER - The login name of the user, used if the Authors field is blank" ] + in + let info = Cmd.info "new" ~doc ~man in + Cmd.v info new_t diff --git a/branches/origin/cmd/txt/peers.ml b/branches/origin/cmd/txt/peers.ml new file mode 100644 index 0000000..25753b4 --- /dev/null +++ b/branches/origin/cmd/txt/peers.ml @@ -0,0 +1,42 @@ +let print_peers_of_peer p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_peer () peer = + let open Kosuzu.Peers in + Printf.printf "%s" peer.path; + List.iter (Printf.printf "\t%s\n") peer.pack.info.locations + +let remove_repo id = + let repopath = Filename.concat Kosuzu.Peers.text_dir id in + match Sys.is_directory repopath with + | false -> Printf.eprintf "No repository %s in %s" id Kosuzu.Peers.text_dir + | true -> + let cmd = Printf.sprintf "rm -r %s" repopath in + Printf.printf "Run: %s ? (y/N) %!" cmd; + match input_char stdin with + |'y'-> if Sys.command cmd = 0 then print_endline "Removed" else prerr_endline "Failed" + | _ -> () + +let peers = function + | Some id -> remove_repo id + | None -> + Printf.printf "Peers in %s\n" Kosuzu.Peers.text_dir; + Kosuzu.Peers.fold print_peer () + +open Cmdliner +let remove = Arg.(value & opt (some string) None & info ["remove"] ~docv:"Repository ID" ~doc:"Remove repository texts and from future pulling") +let peers_t = Term.(const peers $ remove) + +let cmd = + let doc = "List current peers" in + let man = [ + `S Manpage.s_description; + `P "List current peers and associated information" ] + in + let info = Cmd.info "peers" ~doc ~man in + Cmd.v info peers_t diff --git a/branches/origin/cmd/txt/pull.ml b/branches/origin/cmd/txt/pull.ml new file mode 100644 index 0000000..7b5766f --- /dev/null +++ b/branches/origin/cmd/txt/pull.ml @@ -0,0 +1,137 @@ +let writer accum data = + Buffer.add_string accum data; + String.length data + +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; + 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 Kosuzu.File_store.to_text @@ Filename.(concat dir (Kosuzu.Id.short id) ^ ".txt") with + | Error x -> prerr_endline x; true + | Ok txt -> time > (Kosuzu.(Header_pack.date (Date.listing txt.date))) + | exception (Sys_error _) -> true + +let print_peers p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_pull_start width total title dir = + Printf.printf "%*d/%s %s => %s %!" width 0 total title dir + +let print_pull width total i = + Printf.printf "\r%*d/%s %!" width (i+1) total + +let printers total title dir = + let width = String.length total in + print_pull_start width total title dir; + print_pull width total + +let fname dir text = Filename.concat dir (Kosuzu.Text.short_id text ^ ".txt") + +let pull_text url dir id = + let u = Filename.concat url ((Kosuzu.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 Kosuzu.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 per_text url dir filter print i id time title authors topics _refs _reps = match id with + | "" -> Printf.eprintf "\nInvalid id for %s\n" title + | id -> let open Kosuzu in + print i; + if newer time id dir + && (String_set.empty = filter.topics + || String_set.exists (fun t -> List.mem t topics) filter.topics) + && (Person.Set.empty = filter.authors + || Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors) + then pull_text url dir id + +let pull_index url authors_opt topics_opt = + let index_url = Filename.concat url "index.pck" in + match curl_pull index_url with + | Error s -> prerr_endline s; false + | Ok body -> + match Kosuzu.Header_pack.of_string (Buffer.contents body) with + | Error s -> Printf.printf "Error with %s: %s\n" url s; false + | Ok pk when pk.info.id = "" -> + Printf.printf "Empty ID index.pck, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_length pk.info.id) -> + Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_chars pk.info.id) -> + Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false + | Ok pk -> + let dir = Filename.concat Kosuzu.Peers.text_dir pk.info.id in + Kosuzu.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 ( Kosuzu.Header_pack.string { + pk with info = { pk.info with locations = url::pk.info.locations }}); + close_out file; + let filter = let open Kosuzu in { + authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty); + topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty); + } in + let name = match pk.info.title with "" -> url | title -> title in + let print = printers (string_of_int @@ Kosuzu.Header_pack.numof_texts pk) name dir in + try Kosuzu.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true + with Invalid_argument msg -> Printf.printf "\nFailed to parse %s: %s\n%!" url msg; false + +let pull_list auths topics = + Curl.global_init Curl.CURLINIT_GLOBALALL; + let pull got_one peer_url = if got_one then got_one else + (pull_index peer_url auths topics) in + let open Kosuzu in + let fold_locations init peer = + ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations; + false + in + ignore @@ Peers.fold fold_locations false; + Curl.global_cleanup () + +let pull url auths topics = match url with + | "" -> pull_list auths topics | x -> ignore (pull_index x auths topics) + +open Cmdliner +let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"Comma-separated names" ~doc:"Filter by authors") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"Comma-separated topics" ~doc:"Filter by topics") +let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"Repository location") + +let pull_t = Term.(const pull $ url $ authors $ topics) + +let cmd = + let doc = "Pull listed texts" in + let man = [ + `S Manpage.s_description; + `P "Pull texts from known repositories." ] + in + let info = Cmd.info "pull" ~doc ~man in + Cmd.v info pull_t diff --git a/branches/origin/cmd/txt/recent.ml b/branches/origin/cmd/txt/recent.ml new file mode 100644 index 0000000..3b46085 --- /dev/null +++ b/branches/origin/cmd/txt/recent.ml @@ -0,0 +1,23 @@ +open Kosuzu +module FS = File_store +module A = Archive + +open Cmdliner +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) (Some 10) & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts with topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "Directory to index") + +let recent_t = Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics $ dir) +let cmd = + let doc = "List recent texts" in + let man = [ + `S Manpage.s_description; + `P "List header information of most recent texts."; + `P "If -R is used, list header information for texts found in subdirectories, too, along with their filepaths" ] + in + let info = Cmd.info "recent" ~doc ~man in + Cmd.v info recent_t diff --git a/branches/origin/cmd/txt/topics.ml b/branches/origin/cmd/txt/topics.ml new file mode 100644 index 0000000..9c2c936 --- /dev/null +++ b/branches/origin/cmd/txt/topics.ml @@ -0,0 +1,21 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated authors" ~doc: "Topics by authors") +let topics_t = Term.(const topics $ recurse $ authed) + +let cmd = + let doc = "List topics" in + let man = [ + `S Manpage.s_description; + `P "List of topics" ] + in + let info = Cmd.info "topics" ~doc ~man in + Cmd.v info topics_t diff --git a/branches/origin/cmd/txt/txt.ml b/branches/origin/cmd/txt/txt.ml new file mode 100644 index 0000000..a105d3c --- /dev/null +++ b/branches/origin/cmd/txt/txt.ml @@ -0,0 +1,36 @@ +open Cmdliner + +let subs = [ + Authors.cmd; + Convert.cmd; + Edit.cmd; + File.cmd; + Index.cmd; + Last.cmd; + Listing.cmd; + New.cmd; + Peers.cmd; + Pull.cmd; + Recent.cmd; + Topics.cmd; + Unfile.cmd; + ] + +let default_cmd = Term.(ret (const (`Help (`Pager, None)))) + +let txt = + let doc = "Discover, collect and exchange texts" in + let man = [ + `S Manpage.s_authors; + `P "orbifx "; + `P "Izuru Yakumo "; + `S Manpage.s_bugs; + `P "Please report them at "; + `S Manpage.s_see_also; + `P "This program is named after Kosuzu Motoori from Touhou Suzunaan: Forbidden Scrollery"; + `P "https://en.touhouwiki.net/wiki/Forbidden_Scrollery" ] + in + Cmd.group (Cmd.info "txt" ~version:"%%VERSION%%" ~doc ~man) ~default:default_cmd subs + +let main () = exit (Cmd.eval txt) +let () = main () diff --git a/branches/origin/cmd/txt/unfile.ml b/branches/origin/cmd/txt/unfile.ml new file mode 100644 index 0000000..7d29aef --- /dev/null +++ b/branches/origin/cmd/txt/unfile.ml @@ -0,0 +1,21 @@ +open Kosuzu + +let unfile files = + let dirs, files = File_store.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 files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") + +let unfile_t = Term.(const unfile $ files) + +let cmd = + let doc = "Unfile texts from subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Unfile texts in parameter from directories in parameter, by removing hardlinks" ] + in + let info = Cmd.info "unfile" ~doc ~man in + Cmd.v info unfile_t diff --git a/branches/origin/cmd/txt_init/dune b/branches/origin/cmd/txt_init/dune new file mode 100644 index 0000000..6090b4e --- /dev/null +++ b/branches/origin/cmd/txt_init/dune @@ -0,0 +1,5 @@ +(executable + (name txt_init) + (public_name txt_init) + (modules txt_init) + (libraries kosuzu)) diff --git a/branches/origin/cmd/txt_init/txt_init.ml b/branches/origin/cmd/txt_init/txt_init.ml new file mode 100644 index 0000000..30b9c53 --- /dev/null +++ b/branches/origin/cmd/txt_init/txt_init.ml @@ -0,0 +1,17 @@ +let init_repo = + print_endline "Initializing repository..."; + print_endline "It's required for the repository name and id."; + print_endline "Create one? (y/n)"; + match input_line stdin with + |"y"-> + let title = + print_endline "Title for repository: "; + input_line stdin in + let authors = + print_endline "Authors (format: name ): "; + input_line stdin in + Kosuzu.File_store.file "txt.conf" + (Printf.sprintf "Id:%s\nTitle: %s\nAuthors: %s\n" (Kosuzu.Id.generate ()) title authors); + Kosuzu.File_store.of_kv_file () + | _ -> + print_endline "Aborting..."; exit 1 diff --git a/branches/origin/dune-project b/branches/origin/dune-project new file mode 100644 index 0000000..6603f46 --- /dev/null +++ b/branches/origin/dune-project @@ -0,0 +1,16 @@ +(lang dune 2.0) +(name kosuzu) +(version 1.4.3) +(license EUPL-1.2) +(authors "orbifx ") +(bug_reports "mailto:kosuzu-dev@chaotic.ninja") +(maintainers "Izuru Yakumo ") +(homepage "https://suzunaan.chaotic.ninja/kosuzu/") +(source (uri git+https://git.chaotic.ninja/yakumo.izuru/kosuzu)) + +(generate_opam_files true) + +(package + (name kosuzu) + (synopsis "Texts archival and exchange") + (depends ocaml dune ocurl msgpck cmdliner)) diff --git a/branches/origin/kosuzu.opam b/branches/origin/kosuzu.opam new file mode 100644 index 0000000..550e165 --- /dev/null +++ b/branches/origin/kosuzu.opam @@ -0,0 +1,25 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "1.4.3" +synopsis: "Texts archival and exchange" +maintainer: ["Izuru Yakumo "] +authors: ["orbifx "] +license: "EUPL-1.2" +homepage: "https://suzunaan.chaotic.ninja/kosuzu/" +bug-reports: "mailto:kosuzu-dev@chaotic.ninja" +depends: ["ocaml" "dune" "ocurl" "msgpck" "cmdliner"] +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://git.chaotic.ninja/yakumo.izuru/kosuzu" diff --git a/branches/origin/lib/archive.ml b/branches/origin/lib/archive.ml new file mode 100644 index 0000000..a04d660 --- /dev/null +++ b/branches/origin/lib/archive.ml @@ -0,0 +1,36 @@ +let predicate fn opt = Option.(to_list @@ map fn opt) + +let authored query_string = + let q = Person.Set.of_query @@ String_set.query query_string in + fun n -> Person.Set.predicate q n.Text.authors + +let ided query_string = + let len = String.length query_string in + fun n -> + try String.sub n.Text.id 0 len = query_string + with Invalid_argument _ -> false + +let keyworded query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Keywords" n)) + +let topics query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Topics" n)) + +let apply_sys_util env def_env r order_opt reverse_opt number_opt authors_opt topics_opt id_opt = + let predicates = if id_opt <> "" then [ ided id_opt ] else [] + @ predicate authored authors_opt + @ predicate topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let util = try Sys.getenv env with Not_found -> def_env in + let print_text acc (_t, fnames) = Printf.sprintf "%s %s" acc (List.hd fnames) in + let paths = match order_opt with + | false -> File_store.fold ~r ~predicate print_text "" + | true -> + let order = match reverse_opt with true -> File_store.newest | false -> File_store.oldest in + match number_opt with + | Some number -> File_store.fold ~r ~predicate ~order ~number print_text "" + | None -> File_store.fold ~r ~predicate ~order print_text "" + in if paths = "" then () + else (ignore @@ Sys.command @@ Printf.sprintf "%s %s" util paths) diff --git a/branches/origin/lib/category.ml b/branches/origin/lib/category.ml new file mode 100644 index 0000000..ac807b6 --- /dev/null +++ b/branches/origin/lib/category.ml @@ -0,0 +1,22 @@ +module Category = struct + type t = Unlisted | Published | Invalid | Custom of string + let compare = Stdlib.compare + let of_string = function "unlisted" | "published" -> Invalid | c -> Custom c + let to_string = function Custom c -> c | _ -> "" +end + +include Category + +module CategorySet = struct + include Set.Make (Category) + let of_stringset s = String_set.fold (fun e a -> add (Category.of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set + let of_string x = of_stringset (String_set.of_string x) + let to_string set = + let f elt a = + let s = Category.to_string elt in + if a <> "" then a ^ ", " ^ s else s + in + fold f set "" +end diff --git a/branches/origin/lib/date.ml b/branches/origin/lib/date.ml new file mode 100644 index 0000000..6eab0d9 --- /dev/null +++ b/branches/origin/lib/date.ml @@ -0,0 +1,22 @@ +type t = { created: string; edited: string } +let compare = compare +let rfc_string date = date +let of_string (rfc : string) = rfc +let listing date = if date.edited <> "" then date.edited else date.created +let months = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|] +let pretty_date date = + try Scanf.sscanf date "%4s-%d-%2s" (fun y m d -> Printf.sprintf "%s %s, %s" d (months.(m-1)) y) + with + | Scanf.Scan_failure s as e -> Printf.fprintf stderr "%s for %s\n" s date; raise e + | Invalid_argument _s as e -> Printf.fprintf stderr "Parsing %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) +let of_secs s = + let { Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours; + tm_mday=day; tm_mon=month; tm_year=year; _ } = Unix.localtime (float_of_int s) in + Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02d" + (year+1900) (month+1) day hours minutes seconds diff --git a/branches/origin/lib/dune b/branches/origin/lib/dune new file mode 100644 index 0000000..119bdd5 --- /dev/null +++ b/branches/origin/lib/dune @@ -0,0 +1,4 @@ +(library + (name kosuzu) + (public_name kosuzu) + (libraries text_parse text_parse.parsers unix str msgpck)) diff --git a/branches/origin/lib/file_store.ml b/branches/origin/lib/file_store.ml new file mode 100644 index 0000000..89afa21 --- /dev/null +++ b/branches/origin/lib/file_store.ml @@ -0,0 +1,150 @@ +type t = string +type item_t = t list +type record_t = Text.t * item_t + +let extension = ".txt" + +let txtdir () = try Sys.getenv "TXTDIR" with Not_found -> + let share = Filename.concat (Sys.getenv "HOME") ".local/share/texts/" in + match Sys.is_directory share with true -> share + | false | exception (Sys_error _) -> "." + +let cfgpath () = match "txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> match Filename.concat (Sys.getenv "HOME") ".config/txt/txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> "" + +let to_string f = + let ic = open_in f in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s + +let fold_file_line fn init file = match open_in file with + | 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 file path str = let o = open_out path in output_string o str; close_out o + +let to_text path = + if Filename.extension path = extension then + (to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m)) + else Error (Printf.sprintf "Not txt: %s" path) + +let newest (a,_pa) (b,_pb) = Text.newest a b +let oldest (a,_pa) (b,_pb) = Text.oldest a b + +let list_iter fn dir paths = + let link f = match to_text (Filename.concat dir f) with + | Ok t -> fn dir t f | Error s -> prerr_endline s in + List.iter link paths + +module TextMap = Map.Make(Text) + +type iteration_t = item_t TextMap.t +let new_iteration = TextMap.empty + +(*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 + +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 + +(* 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 + | f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result + | f::fs -> loop (f::result) fs + | [] -> result in + let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else + if not r then expand_dir dir else [dir] in + loop [] dirs + +let list_take n = + let rec take acc n = function [] -> [] + | x::_ when n = 1 -> x::acc + | x::xs -> take (x::acc) (n-1) xs + in take [] n + +let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist = + (match number with None -> (fun x -> x) | Some n -> list_take n) + @@ List.fast_sort comp @@ TextMap.bindings + @@ List.fold_left (fold_valid_text predicate) new_iteration flist + +let iter ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn = + let flist = list_fs ~r dir in match order with + | Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist + | None -> List.iter fn @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let fold ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn acc = + let flist = list_fs ~r dir in match order with + | Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist + | None -> List.fold_left fn acc @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let with_dir ?(descr="") ?(perm=0o740) dir = + let mkdir dir = match Unix.mkdir dir perm with + | exception Unix.Unix_error (EEXIST, _, _) -> () + | exception Unix.Unix_error (code, _fn, arg) -> + failwith @@ Printf.sprintf "Error %s making %s dir: %s" + (Unix.error_message code) descr arg + | _ -> () in + 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 rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl + +let versioned_basename_of_title ?(version=0) repo extension (title : string) = + let basename = Text.string_alias title in + let rec next version = + let candidate = Filename.concat repo + (basename ^ "." ^ string_of_int version ^ extension) in + if Sys.file_exists candidate then next (succ version) else candidate + in + next version + +let id_filename repo extension text = + let description = match Text.alias text with "" -> "" | x -> "." ^ x in + let candidate = Filename.concat repo (text.id ^ description ^ extension) in + if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate + +let with_text ?(dir=txtdir ()) new_text = + match id_filename dir extension new_text with + | Error _ as e -> e + | Ok path -> + try file path (Text.to_string new_text); Ok (path, new_text) + with Sys_error s -> Error s + +module Config = struct + type t = string Store.KV.t + let key_value k v a = Store.KV.add k (String.trim v) a +end + +let of_kv_file ?(path=cfgpath ()) () = + let open Text_parse in + let subsyntaxes = Parsers.Key_value.[| + (module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in + let of_string text acc = + Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in + if path <> "" then of_string (to_string @@ path) Store.KV.empty + else Store.KV.empty diff --git a/branches/origin/lib/header_pack.ml b/branches/origin/lib/header_pack.ml new file mode 100644 index 0000000..1de60e1 --- /dev/null +++ b/branches/origin/lib/header_pack.ml @@ -0,0 +1,133 @@ +let version = 0 +type info_t = { version: int; id: string; title: string; people: string list; locations: string list } +type t = { info: info_t; fields: Msgpck.t; texts: Msgpck.t; peers: Msgpck.t } + +let of_id id = Msgpck.of_string id +let to_id = Msgpck.to_string + +let person p = Msgpck.String (Person.to_string p) +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 + (try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e) + +let of_set field t = + List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) [] + +let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date) + +let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x + +let fields = Msgpck.(List [ + String "id"; String "time"; String "title"; String "authors"; String "topics"; + String "references"; String "replies"; + ]) +let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack) + +let to_info = function + | Msgpck.List (v::id::n::a::ls::[]) -> + let people = to_str_list a in + 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" + +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); + List (of_set "references" t); + List (of_set "in-reply-to" 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 + | Msgpck.List (i::fields::texts::[]) -> + Ok { info = to_info i; fields; texts; peers = Msgpck.List [] } + | Msgpck.List (i::fields::texts::peers::[]) -> + Ok { info = to_info i; fields; texts; peers } + | _ -> Error "format mismatch" + +let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s + +let of_kv kv = + let find k kv = try Store.KV.find k kv with Not_found -> "" in + let find_ls k kv = try String_set.list_of_csv (Store.KV.find k kv) with Not_found -> [] in + { + info = { version = version; id = find "Id" kv; title = find "Title" kv; + people = find_ls "Authors" kv; locations = find_ls "Locations" kv }; + fields; + texts = Msgpck.List []; + peers = str_list (find_ls "Peers" kv); + } + +let list filename = try + let texts_list = function + | Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts + | _ -> prerr_endline "malformed feed"; [] in + let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in + Ok (texts_list data) + with Not_found -> Error "unspecified export dir" + +let contains text = function + | Msgpck.List (id::_time::title::_authors::_topics::[]) -> + (match to_id id with + | "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false + | id -> text.Text.id = id) + | _ -> prerr_endline ("Invalid record pattern"); false + +let numof_texts pack = List.length (Msgpck.to_list pack.texts) + +let txt_iter_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = + try begin match extra with [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end with e -> prerr_endline "iter ref reps"; raise e + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x) + +let txt_fold_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = begin match extra with + | [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i + +let iteri fn pack = List.iteri + (txt_iter_apply fn) + (Msgpck.to_list pack.texts) + +let fold fn init pack = List.fold_left + (fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init + (try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e) diff --git a/branches/origin/lib/id.ml b/branches/origin/lib/id.ml new file mode 100644 index 0000000..fe494d6 --- /dev/null +++ b/branches/origin/lib/id.ml @@ -0,0 +1,22 @@ +let random_state = Random.State.make_self_init + +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 diff --git a/branches/origin/lib/peers.ml b/branches/origin/lib/peers.ml new file mode 100644 index 0000000..8b2ae69 --- /dev/null +++ b/branches/origin/lib/peers.ml @@ -0,0 +1,25 @@ +let text_dir = Filename.concat (File_store.txtdir ()) "peers" + +type t = { path: string; pack: Header_pack.t } + +let fold fn init = match Sys.readdir text_dir with + | exception (Sys_error msg) -> prerr_endline msg; init + | dirs -> + let read_pack init path = + let fullpath = Filename.concat text_dir path in + if Sys.is_directory fullpath then begin + let pack_path = Filename.concat fullpath "index.pck" in + match Sys.file_exists pack_path with + | false -> Printf.eprintf "Missing index.pck for %s\n" path; init + | true -> match Header_pack.of_string (File_store.to_string pack_path) with + | Error s -> Printf.eprintf "%s %s\n" s pack_path; init + | Ok pack -> fn init { path; pack } + end else init + in + Array.fold_left read_pack init 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 diff --git a/branches/origin/lib/person.ml b/branches/origin/lib/person.ml new file mode 100644 index 0000000..e2f3597 --- /dev/null +++ b/branches/origin/lib/person.ml @@ -0,0 +1,32 @@ +module Person = struct + type name_t = string + type address_t = string + type t = { name: name_t; addresses: address_t list } + let empty = { name = ""; addresses = [] } + let compare = Stdlib.compare + 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 -> + match Str.(split (regexp " *< *") s) with + | [] -> empty + | [n] -> let name = String.trim n in { empty with name } + | n::adds -> + let name = String.trim n in + let addresses = List.map (fun f -> String.(sub f 0 (length f -1))) adds in + { name; addresses } +end + +include Person + +module Set = struct + include Set.Make(Person) + let to_string ?(names_only=false) ?(pre="") ?(sep=", ") s = + 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 + fold j s pre + let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s)) + + let of_stringset s = String_set.fold (fun e a -> union (of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set +end diff --git a/branches/origin/lib/reference_set.ml b/branches/origin/lib/reference_set.ml new file mode 100644 index 0000000..6c456ec --- /dev/null +++ b/branches/origin/lib/reference_set.ml @@ -0,0 +1 @@ +module Map = Map.Make(String) diff --git a/branches/origin/lib/store.ml b/branches/origin/lib/store.ml new file mode 100644 index 0000000..a0d435f --- /dev/null +++ b/branches/origin/lib/store.ml @@ -0,0 +1,16 @@ +module KV = Map.Make (String) + +module type T = sig + type t + type item_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 + val of_path: string -> (archive_t, string) result + val newest: record_t -> record_t -> int + val oldest: record_t -> record_t -> int + val with_text: archive_t -> Text.t -> (string * Text.t, string) result + val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> (record_t -> unit) -> archive_t -> unit + val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a +end diff --git a/branches/origin/lib/string_set.ml b/branches/origin/lib/string_set.ml new file mode 100644 index 0000000..fca4fc1 --- /dev/null +++ b/branches/origin/lib/string_set.ml @@ -0,0 +1,20 @@ +include Set.Make(String) + +let list_of_csv x = Str.(split (regexp " *, *")) (String.trim x) +let list_of_ssv x = Str.(split (regexp " +")) (String.trim x) + +let of_string ?(separator=list_of_csv) x = of_list (separator x) +let of_csv_string x = of_string ~separator:list_of_csv x +let of_ssv_string x = of_string ~separator:list_of_ssv x + +let to_string ?(pre="") ?(sep=", ") s = + let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in + fold (fun x acc -> j acc x) s pre + +let query string = + let partition (include_set, exclude_set) elt = + if String.get elt 0 = '!' then (include_set, add String.(sub elt 1 (length elt - 1)) exclude_set) + else (add elt include_set, exclude_set) in + List.fold_left partition (empty, empty) @@ list_of_csv string + +let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set diff --git a/branches/origin/lib/text.ml b/branches/origin/lib/text.ml new file mode 100644 index 0000000..80fb192 --- /dev/null +++ b/branches/origin/lib/text.ml @@ -0,0 +1,122 @@ +module String_map = Map.Make (String) +type t = { + id: Id.t; + title: string; + authors: Person.Set.t; + date: Date.t; + string_map: string String_map.t; + stringset_map: String_set.t String_map.t; + body: string; + } + +let blank ?(id=(Id.generate ())) () = { + id; + title = ""; + authors = Person.Set.empty; + date = Date.({ created = now (); edited = ""}); + string_map = String_map.empty; + stringset_map = String_map.empty; + body = ""; + } + +let compare = Stdlib.compare +let newest a b = Date.(compare a.date b.date) +let oldest a b = Date.(compare b.date a.date) + +let str key m = + try String_map.find (String.lowercase_ascii key) m.string_map + with Not_found -> "" + +let set key m = + try String_map.find (String.lowercase_ascii key) m.stringset_map + with Not_found -> String_set.empty + +let with_str_set ?(separator=String_set.of_csv_string) m key str = + { m with + stringset_map = String_map.add (String.lowercase_ascii key) (separator str) + m.stringset_map + } + +let with_kv x (k,v) = + let trim = String.trim in + match String.lowercase_ascii k with + | "body" -> { x with body = String.trim v } + | "title"-> { x with title = trim v } + | "id" -> (match v with "" -> x | s -> { x with id = s }) + | "author" + | "authors" -> { x with authors = Person.Set.of_string (trim 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 }} + | "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v + | "references" | "in-reply-to" -> with_str_set + ~separator:(fun x -> String_set.map + (fun x -> String.(sub x 1 (length x-2))) (String_set.of_ssv_string x)) + x k v + | k -> { x with string_map = String_map.add k (trim v) x.string_map } + +let kv_of_string line = match Str.(bounded_split (regexp ": *")) line 2 with + | [ key; value ] -> Str.(replace_first (regexp "^#\\+") "" key), value + | [ key ] -> Str.(replace_first (regexp "^#\\+") "" key), "" + | _ -> "","" + +let of_header front_matter = + let fields = List.map kv_of_string (Str.(split (regexp "\n")) front_matter) in + List.fold_left with_kv (blank ~id:Id.nil ()) fields + +let front_matter_body_split s = + if Str.(string_match (regexp ".*:.*")) s 0 + then match Str.(bounded_split (regexp "^$")) s 2 with + | front::body::[] -> (front, body) + | _ -> ("", s) + else ("", s) + +let of_string s = + let front_matter, body = front_matter_body_split s in + try + let note = { (of_header front_matter) with body } in + if note.id <> Id.nil then Ok note else Error "Missing ID header" + with _ -> Error ("Failed parsing" ^ s) + +let str_set key m = String_set.to_string @@ set key m + +let to_string x = + let has_len v = String.length v > 0 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 d field value = match value with "" -> "" + | s -> field ^ ": " ^ Date.rfc_string s ^ "\n" in + let rows = [ + s "ID" x.id; + d "Date" x.date.Date.created; + d "Edited" x.date.Date.edited; + s "Title" x.title; + a x.authors; + s "Licences" (str_set "licences" x); + s "Topics" (str_set "topics" x); + s "Keywords" (str_set "keywords" x); + s "References"(str_set "references" x); (*todo: add to output <>*) + s "In-Reply-To"(str_set "in-reply-to" x); + s "Series" (str_set "series" x); + s "Abstract" (str "abstract" x); + s "Alias" (str "Alias" x) + ] in + String.concat "" rows ^ "\n" ^ x.body + +let string_alias t = + let is_reserved = function + | '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$' + | ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true + | _ -> false + in + let b = Buffer.create (String.length t) in + let filter char = + 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") + else add_char b char + in + String.(iter filter (lowercase_ascii t)); + Buffer.contents b + +let alias t = match str "alias" t with "" -> string_alias t.title | x -> x +let short_id t = Id.short t.id diff --git a/branches/origin/lib/topic_set.ml b/branches/origin/lib/topic_set.ml new file mode 100644 index 0000000..0e723e6 --- /dev/null +++ b/branches/origin/lib/topic_set.ml @@ -0,0 +1,35 @@ +let of_string x = Str.(split (regexp " *> *")) (String.trim x) + +let topic x = + let path = of_string x in + try List.nth path (List.length path - 1) with _ -> "" + +module Map = Map.Make(String) + +let edges x map = try Map.find x map with Not_found -> (String_set.empty, String_set.empty) + +let edges_with_context context (contexts, subtopics) = (String_set.add context contexts, subtopics) +let edges_with_subtopic subtopic (contexts, subtopics) = (contexts, String_set.add subtopic subtopics) + +let rec list_to_map map = function + | [] -> map + | [topic] -> + let edges = edges topic map in + Map.add topic edges map + | context :: topic :: tail -> + let context_edges = edges context map in + let topic_edges = edges topic map in + let map = + map + |> Map.add context (edges_with_subtopic topic context_edges) + |> Map.add topic (edges_with_context context topic_edges) + in + list_to_map map (topic :: tail) + +let to_map map set = + List.fold_left (fun acc elt -> list_to_map acc (of_string elt)) map @@ String_set.elements set + +let roots map = + let root_keys acc (key, (contexts, _topics)) = if String_set.is_empty contexts then key :: acc else acc in + List.fold_left root_keys [] @@ Map.bindings map + diff --git a/branches/origin/lib/validate.ml b/branches/origin/lib/validate.ml new file mode 100644 index 0000000..5ee17bd --- /dev/null +++ b/branches/origin/lib/validate.ml @@ -0,0 +1,5 @@ +let validate_id_length s = String.length s <= 32 +let validate_id_chars s = try + String.iter (function 'a'..'z'|'A'..'Z'|'0'..'9'-> () | _ -> raise (Invalid_argument "")) s; + true + with Invalid_argument _ -> false diff --git a/trunk/.gitignore b/trunk/.gitignore new file mode 100644 index 0000000..7281ccd --- /dev/null +++ b/trunk/.gitignore @@ -0,0 +1,12 @@ +.merlin +.logarion +*.ymd +\#*\# +.\#*1 +*~ +*.o +*.native +_build +*.htm +index.html +/.svn diff --git a/trunk/LICENSE b/trunk/LICENSE new file mode 100644 index 0000000..fa3348e --- /dev/null +++ b/trunk/LICENSE @@ -0,0 +1,153 @@ +EUROPEAN UNION PUBLIC LICENCE v. 1.2 +EUPL © the European Union 2007, 2016 + +This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such use is covered by a right of the copyright holder of the Work). + +The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following notice immediately following the copyright notice for the Work: + +Licensed under the EUPL + +or has expressed by any other means his willingness to license under the EUPL. + +1. Definitions +In this Licence, the following terms have the following meaning: + +— ‘The Licence’: this Licence. + +— ‘The Original Work’: the work or software distributed or communicated by the Licensor under this Licence, available as Source Code and also as Executable Code as the case may be. + +— ‘Derivative Works’: the works or software that could be created by the Licensee, based upon the Original Work or modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in the country mentioned in Article 15. + +— ‘The Work’: the Original Work or its Derivative Works. + +— ‘The Source Code’: the human-readable form of the Work which is the most convenient for people to study and modify. + +— ‘The Executable Code’: any code which has generally been compiled and which is meant to be interpreted by a computer as a program. + +— ‘The Licensor’: the natural or legal person that distributes or communicates the Work under the Licence. + +— ‘Contributor(s)’: any natural or legal person who modifies the Work under the Licence, or otherwise contributes to the creation of a Derivative Work. + +— ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of the Work under the terms of the Licence. + +— ‘Distribution’ or ‘Communication’: any act of selling, giving, lending, renting, distributing, communicating, transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential functionalities at the disposal of any other natural or legal person. + +2. Scope of the rights granted by the Licence +The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for the duration of copyright vested in the Original Work: + +— use the Work in any circumstance and for all usage, + +— reproduce the Work, + +— modify the Work, and make Derivative Works based upon the Work, + +— communicate to the public, including the right to make available or display the Work or copies thereof to the public and perform publicly, as the case may be, the Work, + +— distribute the Work or copies thereof, + +— lend and rent the Work or copies thereof, + +— sublicense rights in the Work or copies thereof. + +Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the applicable law permits so. + +In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed by law in order to make effective the licence of the economic rights here above listed. + +The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the extent necessary to make use of the rights granted on the Work under this Licence. + +3. Communication of the Source Code +The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to distribute or communicate the Work. + +4. Limitations on copyright +Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations thereto. + +5. Obligations of the Licensee +The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those obligations are the following: + +Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work to carry prominent notices stating that the Work has been modified and the date of modification. +Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless the Original Work is expressly distributed only under this version of the Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the Work or Derivative Work that alter or restrict the terms of the Licence. +Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. +Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available for as long as the Licensee continues to distribute or communicate the Work. +Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the copyright notice. +6. Chain of Authorship +The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. + +Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contri butions to the Work, under the terms of this Licence. + +7. Disclaimer of Warranty +The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work and may therefore contain defects or ‘bugs’ inherent to this type of development. + +For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this Licence. + +This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. + +8. Disclaimer of Liability +Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. + +9. Additional agreements +While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by the fact You have accepted any warranty or additional liability. + +10. Acceptance of the Licence +The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms and conditions. + +Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution or Communication by You of the Work or copies thereof. + +11. Information to the public +In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, by offering to download the Work from a remote location) the distribution channel or media (for example, a website) must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence and the way it may be accessible, concluded, stored and reproduced by the Licensee. + +12. Termination of the Licence +The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms of the Licence. + +Such a termination will not terminate the licences of any person who has received the Work from the Licensee under the Licence, provided such persons remain in full compliance with the Licence. + +13. Miscellaneous +Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the Work. + +If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid and enforceable. + +The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. New versions of the Licence will be published with a unique version number. + +All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take advantage of the linguistic version of their choice. + +14. Jurisdiction +Without prejudice to specific agreement between parties, + +— any litigation resulting from the interpretation of this License, arising between the European Union institutions, bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, + +— any litigation arising between other parties and resulting from the interpretation of this License, will be subject to the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. + +15. Applicable Law +Without prejudice to specific agreement between parties, + +— this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, resides or has his registered office, + +— this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside a European Union Member State. + +Appendix +‘Compatible Licences’ according to Article 5 EUPL are: + +— GNU General Public License (GPL) v. 2, v. 3 + +— GNU Affero General Public License (AGPL) v. 3 + +— Open Software License (OSL) v. 2.1, v. 3.0 + +— Eclipse Public License (EPL) v. 1.0 + +— CeCILL v. 2.0, v. 2.1 + +— Mozilla Public Licence (MPL) v. 2 + +— GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 + +— Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software + +— European Union Public Licence (EUPL) v. 1.1, v. 1.2 + +— Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) + +The European Commission may update this Appendix to later versions of the above licences without producing a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the covered Source Code from exclusive appropriation. + +All other changes or additions to this Appendix require the production of a new EUPL version. diff --git a/trunk/Makefile b/trunk/Makefile new file mode 100644 index 0000000..1baf879 --- /dev/null +++ b/trunk/Makefile @@ -0,0 +1,31 @@ +OS=`uname -s` +MACHINE=`uname -m` +DATE=`date -r _build/default/cmd/txt/txt.exe +%Y%m%d` +COMMIT=`git rev-parse --short HEAD` +PREFIX=/usr/local + +CC=cc +LD=cc + +all: + @dune build +deps: + @opam install dune ocurl cmdliner msgpck +txt: + @dune build cmd/txt/txt.exe +clean: + @dune clean +dist: + @dune build + @cp _build/default/cmd/txt/txt.exe txt.exe + @strip txt.exe + @tar czvf "kosuzu-${OS}-${MACHINE}-${DATE}-${COMMIT}" txt.exe readme.txt + @rm txt.exe + +txt_init: + @dune build cmd/txt_init/txt_init.exe +install: + @dune install --prefix ${PREFIX} +uninstall: + @dune uninstall --prefix ${PREFIX} +.PHONY: txt txt_init diff --git a/trunk/README.md b/trunk/README.md new file mode 100644 index 0000000..700fb9c --- /dev/null +++ b/trunk/README.md @@ -0,0 +1,5 @@ +# Kosuzu +Text archival and exchange, named after [Kosuzu Motoori](https://en.touhouwiki.net/wiki/Kosuzu_Motoori) from [Forbidden Scrollery](https://en.touhouwiki.net/wiki/Forbidden_Scrollery). + +## Contact +* [Mailing list](mailto:kosuzu-dev@chaotic.ninja) diff --git a/trunk/TODO.md b/trunk/TODO.md new file mode 100644 index 0000000..f289c40 --- /dev/null +++ b/trunk/TODO.md @@ -0,0 +1,3 @@ +# To-do +* Support [geomyidae](gopher://bitreich.org/1/scm/geomyidae) `.gph` indexes, for now those can be generated manually somewhat +* Support tab-separated value gophermaps for any other gopher daemon diff --git a/trunk/cmd/txt/atom.ml b/trunk/cmd/txt/atom.ml new file mode 100644 index 0000000..aab1b53 --- /dev/null +++ b/trunk/cmd/txt/atom.ml @@ -0,0 +1,71 @@ +let ext = ".atom" + +let esc = Converter.Html.esc + +let element tag content = "<" ^ tag ^ ">" ^ content ^ "" + +let opt_element tag_name content = + if content <> "" + then element tag_name content + else "" + +module P = Parsers.Plain_text.Make (Converter.Html) + +let id txt = "urn:txtid:" ^ Kosuzu.(txt.Text.id) ^ "\n" +let title text = "" ^ esc text.Kosuzu.Text.title ^ "\n" + +let authors text = + let u acc addr = acc ^ element "uri" addr in + let open Kosuzu in + let fn txt a = + a ^ "" ^ (opt_element "name" @@ esc txt.Person.name) + ^ (List.fold_left u "" txt.Person.addresses) + ^ "\n" in + Person.Set.fold fn text.Text.authors "" + +let updated txt = let open Kosuzu in + ""^ Date.(txt.Text.date |> listing |> rfc_string) ^"\n" + +let htm_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let gmi_entry base_url text = + let open Kosuzu in + let u = Text.short_id text in + "\n\n" + ^ title text ^ id text ^ updated text ^ authors text + ^ (opt_element "summary" @@ esc @@ Text.str "abstract" text) + ^ String_set.fold (fun elt a -> a ^ "\n") (Text.set "topics" text) "" + ^ "\n" + +let base_url kv protocol = try + let locs = Kosuzu.Store.KV.find "Locations" kv in + let _i = Str.(search_forward (regexp (protocol ^ "://[^;]*")) locs 0) in + Str.(matched_string locs) + with Not_found -> Printf.eprintf "Missing location for %s, add it to txt.conf\n" protocol; "" + +let indices alternate_type c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let title = try Kosuzu.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in + let entry, fname, protocol_regexp = match alternate_type with + | "text/gemini" -> gmi_entry, "gmi.atom", "gemini" + | "text/html" | _ -> htm_entry, "feed.atom", "https?" + in + let base_url = base_url c.kv protocol_regexp in + let self = Filename.concat base_url fname in + file fname @@ (*TODO: alternate & self per url*) + {||} + ^ title ^ {|urn:txtid:|} ^ c.Conversion.id ^ "" + ^ Kosuzu.Date.now () ^ "\n" + ^ List.fold_left (fun acc t -> acc ^ entry base_url t) "" c.texts + ^ "" + +let converter format = Conversion.{ ext; page = None; indices = Some (indices format) } diff --git a/trunk/cmd/txt/authors.ml b/trunk/cmd/txt/authors.ml new file mode 100644 index 0000000..6fd77cc --- /dev/null +++ b/trunk/cmd/txt/authors.ml @@ -0,0 +1,22 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories too") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"topics" ~doc: "Display authors who have written on topics") + +let authors_t = Term.(const authors $ recurse $ topics) + +let cmd = + let doc = "List authors" in + let man = [ + `S Manpage.s_description; + `P "List author names" ] + in + let info = Cmd.info "authors" ~doc ~man in + Cmd.v info authors_t diff --git a/trunk/cmd/txt/conversion.ml b/trunk/cmd/txt/conversion.ml new file mode 100644 index 0000000..12f74aa --- /dev/null +++ b/trunk/cmd/txt/conversion.ml @@ -0,0 +1,74 @@ +open Kosuzu + +module Rel = struct + +module Rel_set = Set.Make(String) +module Id_map = Map.Make(String) + +type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t } +type map_t = t Id_map.t + +let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty } +let empty_map = Id_map.empty + +let acc_ref date source target = Id_map.update target (function + | None -> Some { last_rel = date; + ref_set = Rel_set.singleton source; + rep_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + ref_set = Rel_set.add source rel.ref_set }) + +let acc_rep date source target = Id_map.update target (function + | None -> Some { last_rel = date; + rep_set = Rel_set.singleton source; + ref_set = Rel_set.empty } + | Some rel -> Some { rel with + last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel; + rep_set = Rel_set.add source rel.rep_set }) + +let acc_txt rels (text, _paths) = + let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in + let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in + let rels = String_set.fold acc_ref (Text.set "references" text) rels in + let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in + rels + +let acc_pck rels peer = + let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in + try Header_pack.fold + (fun rels id t _title _authors _topics refs_ls reps_ls -> + let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in + let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in + let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in + rels) + rels peer.Peers.pack + with e -> prerr_endline "acc_pck"; raise e +end + + +type t = { + id: string; + dir: string; + kv: string Store.KV.t; + topic_roots: string list; + topics: (String_set.t * String_set.t) Topic_set.Map.t; + relations: Rel.map_t; + texts: Text.t list +} + +type fn_t = { + ext: string; + page: (t -> Kosuzu.Text.t -> string) option; + indices: (t -> unit) option; +} + +let empty () = { + id = ""; dir = ""; + kv = Store.KV.empty; + topic_roots = []; + topics = Topic_set.Map.empty; + relations = Rel.Id_map.empty; + texts = [] +} diff --git a/trunk/cmd/txt/convert.ml b/trunk/cmd/txt/convert.ml new file mode 100644 index 0000000..4ee7de2 --- /dev/null +++ b/trunk/cmd/txt/convert.ml @@ -0,0 +1,95 @@ +open Kosuzu + +let is_older s d = try Unix.((stat d).st_mtime < (stat s).st_mtime) with _-> true + +let convert cs r (text, files) = match Text.str "Content-Type" text with + | "" | "text/plain" -> + let source = List.hd files in + let dest = Filename.concat r.Conversion.dir (Text.short_id text) in + List.fold_left (fun a f -> + match f.Conversion.page with None -> false || a + | Some page -> + let dest = dest ^ f.Conversion.ext in + (if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations + then (File_store.file dest (page r text); true) else false) + || a) + false cs + | x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false + +let converters types kv = + let n = String.split_on_char ',' types in + let t = [] in + let t = if List.(mem "all" n || mem "htm" n) then (Html.converter kv)::t else t in + let t = if List.(mem "all" n || mem "atom" n) then (Atom.converter "text/html")::t else t in + let t = if List.(mem "all" n || mem "gmi" n) then (Gemini.converter)::t else t in + let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in + t + +let directory converters noindex repo = + let order = File_store.oldest in + let repo = + let open Conversion in + let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in + let relations = Peers.fold Rel.acc_pck rels in + { repo with relations } in + let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls, + if convert converters repo r then acc+1 else acc in + let topics, texts, count = + File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in + let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv) + with Not_found -> Topic_set.roots topics in + let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in + if not noindex then + List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters; + Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts) + +let load_kv dir = + let kv = File_store.of_kv_file () in + let idx = Filename.concat dir "index.pck" in + if not (Sys.file_exists idx) then kv else + match Header_pack.of_string @@ File_store.to_string (idx) with + | Error s -> prerr_endline s; kv + | Ok { info; peers; _ } -> + let kv = if Store.KV.mem "Id" kv then kv else Store.KV.add "Id" info.Header_pack.id kv in + let kv = if Store.KV.mem "Title" kv then kv else Store.KV.add "Title" info.Header_pack.title kv in + let kv = if Store.KV.mem "Locations" kv then kv else Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in + let kv = Store.KV.add "Peers" (String.concat ";\n" Header_pack.(to_str_list peers)) kv in + kv + +let at_path types noindex path = match path with + | "" -> prerr_endline "unspecified text file or directory" + | path when Sys.file_exists path -> + if Sys.is_directory path then ( + let kv = load_kv path in + let repo = { (Conversion.empty ()) with dir = path; kv } in + directory (converters types kv) noindex repo + ) else ( + match File_store.to_text path with + | Error s -> prerr_endline s + | Ok text -> + let dir = "." in + let open Conversion in + let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in + let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in + ignore @@ convert (converters types repo.kv) repo (text, [path]) + ) + | path -> Printf.eprintf "Path doesn't exist: %s" path + +open Cmdliner + +let path = Arg.(value & pos 0 string "" & info [] ~docv:"path" ~doc:"Text file or directory to convert. If directory is provided, it must contain an index.pck (see: txt index)") +let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"output type" ~doc:"Convert to file type") +let noindex = Arg.(value & flag & info ["noindex"] ~doc:"Don't create indices in target format") + +let convert_t = Term.(const at_path $ types $ noindex $ path) + +let cmd = + let doc = "Convert texts" in + let man = [ + `S Manpage.s_description; + `P "Convert text or indexed texts within a directory to another format."; + `P "If path is a directory must contain an index.pck."; + `P "Run `txt index` first." ] + in + let info = Cmd.info "convert" ~doc ~man in + Cmd.v info convert_t diff --git a/trunk/cmd/txt/dune b/trunk/cmd/txt/dune new file mode 100644 index 0000000..471ab7f --- /dev/null +++ b/trunk/cmd/txt/dune @@ -0,0 +1,6 @@ +(executable + (name txt) + (public_name txt) + (modules txt authors convert conversion edit file index last listing + new topics html atom gemini peers pull recent unfile) + (libraries text_parse.converter text_parse.parsers kosuzu msgpck curl str cmdliner)) diff --git a/trunk/cmd/txt/edit.ml b/trunk/cmd/txt/edit.ml new file mode 100644 index 0000000..298e52c --- /dev/null +++ b/trunk/cmd/txt/edit.ml @@ -0,0 +1,22 @@ +open Cmdliner +let id = Arg.(value & pos 0 string "" & info [] ~docv: "text ID") +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts by topics") + +let edit_t = Term.(const (Kosuzu.Archive.apply_sys_util "EDITOR" "nano") $ recurse $ time $ reverse $ number $ authed $ topics $ id) + +let cmd = + let doc = "Edit a text" in + let man = [ + `S Manpage.s_description; + `P "Launches EDITOR (nano if environment variable is unset) with text path as parameter."; + `P "If -R is used, the ID search space includes texts found in subdirectories, too."; + `S Manpage.s_environment; + `P "EDITOR - Default editor name" ] + in + let info = Cmd.info "edit" ~doc ~man in + Cmd.v info edit_t diff --git a/trunk/cmd/txt/file.ml b/trunk/cmd/txt/file.ml new file mode 100644 index 0000000..cea07c8 --- /dev/null +++ b/trunk/cmd/txt/file.ml @@ -0,0 +1,23 @@ +open Kosuzu +let file files = + let dirs, files = File_store.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 + +open Cmdliner +let files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") +let file_t = Term.(const file $ files) + +let cmd = + let doc = "File texts in subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Files all texts in parameter in every directory in parameter, using hardlinks"; + `P "Use it to create sub-repositories for sharing or converting" ] + in + let info = Cmd.info "file" ~doc ~man in + Cmd.v info file_t diff --git a/trunk/cmd/txt/gemini.ml b/trunk/cmd/txt/gemini.ml new file mode 100644 index 0000000..e2136c3 --- /dev/null +++ b/trunk/cmd/txt/gemini.ml @@ -0,0 +1,100 @@ +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 Kosuzu.Text in + "# " ^ text.title + ^ "\nAuthors: " ^ Kosuzu.Person.Set.to_string text.authors + ^ "\nDate: " ^ Kosuzu.Date.(pretty_date @@ listing text.date) + ^ let module T = Parsers.Plain_text.Make (GeminiConverter) in + "\n" ^ T.of_string text.body "" + +let date_index title meta_list = + List.fold_left + (fun a m -> + a ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " ^ + Kosuzu.(Date.(pretty_date (listing m.date)) ^ " " ^ m.title) ^ "\n") + ("# " ^ title ^ "\n\n## Posts by date\n\n") meta_list + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list + in + List.fold_left + (fun a m -> + a + ^ "=> " ^ Kosuzu.Text.short_id m ^ ".gmi " + ^ Kosuzu.(Date.(pretty_date (listing m.Text.date))) ^ " " + ^ m.Kosuzu.Text.title ^ "\n") + "" meta_list + +let topic_link root topic = + 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 open Kosuzu in + "=> " ^ path ^ Text.short_id meta ^ ".gmi " + ^ Date.(pretty_date (listing meta.Text.date)) ^ " " + ^ meta.Text.title ^ "\n" + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) + and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> "## " ^ String.capitalize_ascii topic ^ "\n\n" ^ x + in + item_group topic_roots + +let fold_topic_roots topic_roots = + let list_item root t = topic_link root t in + List.fold_left (fun a x -> a ^ list_item x x) "" (List.rev topic_roots) + +let topic_main_index r title topic_roots metas = + "# " ^ title ^ "\n\n" + ^ (if topic_roots <> [] then ("## Main topics\n\n" ^ fold_topic_roots topic_roots) else "") + ^ "\n## Latest\n\n" ^ to_dated_links ~limit:10 metas + ^ "\n=> index.date.gmi More by date\n\n" + ^ let peers = Kosuzu.Store.KV.find "Peers" r.Conversion.kv in + if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf "%s=> %s\n" a s) "## Peers\n\n" + (Str.split (Str.regexp ";\n") peers) + +let topic_sub_index title topic_map topic_root metas = + "# " ^ title ^ "\n\n" + ^ listing_index topic_map [topic_root] "" metas + +let indices r = + let open Kosuzu 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 r 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 converter = Conversion.{ ext; page = Some page; indices = Some indices} diff --git a/trunk/cmd/txt/html.ml b/trunk/cmd/txt/html.ml new file mode 100644 index 0000000..7fec0d6 --- /dev/null +++ b/trunk/cmd/txt/html.ml @@ -0,0 +1,181 @@ +type templates_t = { header: string option; footer: string option } +type t = { templates : templates_t; style : string } + +let ext = ".htm" +let empty_templates = { header = None; footer = None } +let default_opts = { templates = empty_templates; style = "" } + +let init kv = + let open Kosuzu in + let to_string key kv = match Store.KV.find key kv with + | fname -> Some (File_store.to_string fname) + | exception Not_found -> None in + let header = to_string "HTM-header" kv in + let footer = to_string "HTM-footer" kv in + let style = match to_string "HTM-style" kv with + | Some s -> Printf.sprintf "\n" s | None -> "" in + { templates = { header; footer}; style } + +let wrap conv htm text_title body = + let site_title = try Kosuzu.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in + let replace x = let open Str in + global_replace (regexp "{{archive-title}}") site_title x + |> global_replace (regexp "{{text-title}}") text_title + in + let feed = try Kosuzu.Store.KV.find "HTM-feed" conv.Conversion.kv + with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom") + then "feed.atom" else "" in + let header = match htm.templates.header with + | Some x -> replace x + | None -> Printf.(sprintf "%s%s" site_title + (if feed <> "" then sprintf "feed" feed else "")) + in + let footer = match htm.templates.footer with None -> "" | Some x -> replace x in + Printf.sprintf "\n\n\n\n%s%s\n%s\n%s\n\n\n\n\n\n%s%s%s\n" + text_title (if site_title <> "" then (" • " ^ site_title) else "") + htm.style + (if feed <> "" then Printf.sprintf "" feed else "") + header body footer + +let topic_link root topic = + let replaced_space = String.map (function ' '->'+' | x->x) in + "" + ^ String.capitalize_ascii topic ^ "" + +module HtmlConverter = struct + include Converter.Html + let uid_uri u a = Printf.sprintf "%s<%s>" a u ext u + let angled_uri u a = + if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false + then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a +end + +let page htm conversion text = + let open Kosuzu in + let open Text 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 opt_kv key value = if String.length value > 0 + then "
    " ^ key ^ "
    " ^ value else "" in + let authors = Person.Set.to_string text.authors in + let header = + let time x = Printf.sprintf {||} +(Date.rfc_string x) (Date.pretty_date x) in + let topic_links x = + let to_linked t a = + let ts = Topic_set.of_string t in + sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in + String_set.fold to_linked x "" in + let ref_links x = + let link l = HtmlConverter.uid_uri l "" in + String_set.fold (fun r a -> sep_append a (link r)) x "" in + let references, replies = let open Conversion in + let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in + ref_links ref_set, ref_links rep_set in + "
    " + ^ opt_kv "Title:" text.title + ^ opt_kv "Authors:" authors + ^ opt_kv "Date:" (time (Date.listing text.date)) + ^ opt_kv "Series:" (str_set "series" text) + ^ opt_kv "Topics:" (topic_links (set "topics" text)) + ^ opt_kv "Id:" text.id + ^ opt_kv "Refers:" (ref_links (set "references" text)) + ^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text)) + ^ opt_kv "Referred by:" references + ^ opt_kv "Replies:" replies + ^ {|
    |} in
+        wrap conversion htm text.title ((T.of_string text.body header) ^ "
    ") + +let to_dated_links ?(limit) meta_list = + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list in + List.fold_left + (fun a m -> Printf.sprintf "%s
  • %s %s" a Kosuzu.(Date.(pretty_date (listing m.Text.date))) + (Kosuzu.Text.short_id m) m.Kosuzu.Text.title) + "" meta_list + +let date_index ?(limit) conv htm meta_list = + match limit with + | Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list) + | None -> wrap conv htm "Index" (to_dated_links meta_list) + +let fold_topic_roots topic_roots = + let list_item root t = "
  • " ^ topic_link root t in + "" + +let fold_topics topic_map topic_roots metas = + let open Kosuzu in + let rec unordered_list root topic = + List.fold_left (fun a x -> a ^ list_item root x) "
      " topic + ^ "
    " + and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) +and list_item root t = + let item = + if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas + then topic_link root t else String.capitalize_ascii t in + "
    • " ^ item ^ sub_items root t ^ "
    " in + "" + +let text_item path meta = + let open Kosuzu in + " |} ^ meta.Text.title + ^ "
    " + +let listing_index topic_map topic_roots path metas = + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics + and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + | None -> "" + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) +and items topic = + let items = + let open Kosuzu in + List.fold_left + (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in + match items with + | "" -> "" + | x -> {|

    |} ^ String.capitalize_ascii topic ^ "

    " ^ x in + "" + +let topic_main_index conv htm topic_roots metas = + wrap conv htm "Topics" + (fold_topic_roots topic_roots + ^ "
    More by date|} +^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in +(if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf {|%s
  • %s|} a s s) "

    Peers

      " + (Str.split (Str.regexp ";\n") (Kosuzu.Store.KV.find "Peers" conv.kv)) + ^ "
    ")) + +let topic_sub_index conv htm topic_map topic_root metas = + wrap conv htm topic_root + (fold_topics topic_map [topic_root] metas + ^ listing_index topic_map [topic_root] "" metas) + +let indices htm c = + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" 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 converter kv = + let htm = init kv in + Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) } diff --git a/trunk/cmd/txt/index.ml b/trunk/cmd/txt/index.ml new file mode 100644 index 0000000..a5fd2ed --- /dev/null +++ b/trunk/cmd/txt/index.ml @@ -0,0 +1,93 @@ +open Kosuzu + +let text_editor name x = + let fname, out = Filename.open_temp_file name "" in + output_string out x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let line = input_line inp in + close_in inp; line + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let text_editor_lines name x = + let fname, out = Filename.open_temp_file name "" in + List.iter (fun s -> output_string out (s ^ "\n")) x; flush out; + let r = match Unix.system ("$EDITOR " ^ fname) with + | Unix.WEXITED 0 -> + let inp = open_in fname in + let lines = + let rec acc a = + try let a = String.trim (input_line inp) :: a in acc a + with End_of_file -> a in + acc [] in + close_in inp; lines + | _ -> failwith "Failed launching editor to edit value" in + close_out out; + Unix.unlink fname; + r + +let print_pack pck = + let s ss = String.concat "\n\t" ss in + let open Header_pack in + Printf.printf "Id: %s\nTitle: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n" + pck.info.id pck.info.title (String.concat "," pck.info.people) + (s pck.info.locations) (s (to_str_list pck.peers)) + +type t = { dir : string; index_path: string; pck : Header_pack.t } + +let index r print title auth locs peers = + let edit name index param = if print then index else match param with + | Some "" -> text_editor name index | Some p -> p + | None -> index in + let edits name index param = if print then index else match param with + | Some "" -> text_editor_lines name index | Some p -> String_set.list_of_csv p + | None -> index in + let edits_mp name index param = if print then index else match param with + | Some "" -> Header_pack.str_list (text_editor_lines name (Header_pack.to_str_list index)) + | Some p -> Header_pack.str_list (String_set.list_of_csv p) + | None -> index in + let info = Header_pack.{ r.pck.info with + title = edit "Title" r.pck.info.title title; + people = edits "People" r.pck.info.people auth; + locations = edits "Locations" r.pck.info.locations locs; + } in + let pack = Header_pack.{ info; fields; + texts = of_text_list @@ File_store.fold ~dir:r.dir (fun a (t,_) -> of_text a t) []; + peers = edits_mp "Peers" r.pck.peers peers; + } in + if print then print_pack pack + else (File_store.file r.index_path (Header_pack.string pack)) + +let load dir = + let kv = File_store.of_kv_file () in + let index_path = Filename.concat dir "index.pck" in + index { dir; index_path; pck = Header_pack.of_kv kv } + +open Cmdliner +let print = Arg.(value & flag & info ["print"] ~doc: "Print info") +let title = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["t"; "title"] ~docv: "string" ~doc: "Title for index") +let auth = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["a"; "authors"] ~docv: "Comma-separated names" ~doc: "Index authors") +let locs = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["l"; "location"] ~docv: "Comma-separated URLs" ~doc: "Repository URLs") +let peers = Arg.(value & opt ~vopt:(Some "") (some string) None & info ["p"; "peers"] ~docv: "Comma-separated URLs" ~doc: "URLs to other known text repositories") +let dir = Arg.(value & pos 0 string "." & info [] ~docv: "Directory to index") + +let index_t = Term.(const load $ dir $ print $ title $ auth $ locs $ peers) + +let cmd = + let doc = "Generate an index.pck for texts in a directory" in + let man = [ + `S Manpage.s_description; + `P "An index contains:\n"; + `P "* n info section with: title for the index, the authors, locations (URLs) the texts can be accessed."; + `P "* listing of texts with: ID, date, title, authors, topics."; + `P "* list of other text repositories (peers)"; + `S Manpage.s_environment; + `P "EDITOR - Default editor name"; + `S Manpage.s_see_also; + `P "MessagePack format. https://msgpack.org" ] in + let info = Cmd.info "index" ~doc ~man in + Cmd.v info index_t diff --git a/trunk/cmd/txt/last.ml b/trunk/cmd/txt/last.ml new file mode 100644 index 0000000..b5bf31e --- /dev/null +++ b/trunk/cmd/txt/last.ml @@ -0,0 +1,35 @@ +open Kosuzu + +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' + +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' + +let last search_mine = + let filter = if search_mine then last_mine else last in + match File_store.fold filter None with + | None -> () + | Some (_, f) -> List.iter print_endline f + +open Cmdliner + +let mine = Arg.(value & flag & info ["mine"] ~doc: "Last text authored by me") +let last_t = Term.(const last $ mine) + +let cmd = + let doc = "Most recent text" in + let man = [ + `S Manpage.s_description; + `P "Print the filename of most recent text" ] + in + let info = Cmd.info "last" ~doc ~man in + Cmd.v info last_t diff --git a/trunk/cmd/txt/listing.ml b/trunk/cmd/txt/listing.ml new file mode 100644 index 0000000..fefd3a6 --- /dev/null +++ b/trunk/cmd/txt/listing.ml @@ -0,0 +1,44 @@ +open Kosuzu +module FS = File_store +module A = Archive + +let listing r order_opt reverse_opt number_opt paths_opt authors_opt topics_opt dir = + let dir = if dir = "" then FS.txtdir () else dir in + let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let list_text (t, fnames) = Printf.printf "%s | %s | %s | %s %s\n" + (Text.short_id t) Date.(pretty_date @@ listing t.Text.date) + (Person.Set.to_string ~names_only:true t.Text.authors) + t.Text.title (if paths_opt then (List.fold_left (Printf.sprintf "%s\n@ %s") "" fnames) else "") + in + match order_opt with + | false -> FS.iter ~r ~dir ~predicate list_text + | true -> + let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in + match number_opt with + | Some number -> FS.iter ~r ~dir ~predicate ~order ~number list_text + | None -> FS.iter ~r ~dir ~predicate ~order list_text + +open Cmdliner + +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let time = Arg.(value & flag & info ["t"] ~doc: "Sort by time, newest first") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) None & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "comma-separated topics" ~doc: "Texts by topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "directory to index") + +let listing_t = Term.(const listing $ recurse $ time $ reverse $ number $ paths $ authed $ topics $ dir) + +let cmd = + let doc = "List texts" in + let man = [ + `S Manpage.s_description; + `P "Displays text id, date, author, title for a directory."; + `P "If directory argument is omitted, TXTDIR is used, where empty value defaults to ~/.local/share/texts."; + `P "If -R is used, list header information for texts found in subdirectories, too." ] + in + let info = Cmd.info "list" ~doc ~man in + Cmd.v info listing_t diff --git a/trunk/cmd/txt/new.ml b/trunk/cmd/txt/new.ml new file mode 100644 index 0000000..73f4ebe --- /dev/null +++ b/trunk/cmd/txt/new.ml @@ -0,0 +1,29 @@ +open Kosuzu +open Cmdliner + +let new_txt title topics_opt = + let kv = Kosuzu.File_store.of_kv_file () in + let authors = Person.Set.of_string (try Kosuzu.Store.KV.find "Authors" kv + with Not_found -> Sys.getenv "USER") in + let text = { (Text.blank ()) with title; authors } in + let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _->text in + match File_store.with_text text with + | Error s -> prerr_endline s + | Ok (filepath, _note) -> + print_endline filepath + +let title = Arg.(value & pos 0 string "" & info [] ~docv: "title" ~doc: "Title for new article") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv: "Comma-separated topics" ~doc: "Topics for new article") + +let new_t = Term.(const new_txt $ title $ topics) + +let cmd = + let doc = "Create a new article" in + let man = [ + `S Manpage.s_description; + `P "Create a new article"; + `S Manpage.s_environment; + `P "USER - The login name of the user, used if the Authors field is blank" ] + in + let info = Cmd.info "new" ~doc ~man in + Cmd.v info new_t diff --git a/trunk/cmd/txt/peers.ml b/trunk/cmd/txt/peers.ml new file mode 100644 index 0000000..25753b4 --- /dev/null +++ b/trunk/cmd/txt/peers.ml @@ -0,0 +1,42 @@ +let print_peers_of_peer p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_peer () peer = + let open Kosuzu.Peers in + Printf.printf "%s" peer.path; + List.iter (Printf.printf "\t%s\n") peer.pack.info.locations + +let remove_repo id = + let repopath = Filename.concat Kosuzu.Peers.text_dir id in + match Sys.is_directory repopath with + | false -> Printf.eprintf "No repository %s in %s" id Kosuzu.Peers.text_dir + | true -> + let cmd = Printf.sprintf "rm -r %s" repopath in + Printf.printf "Run: %s ? (y/N) %!" cmd; + match input_char stdin with + |'y'-> if Sys.command cmd = 0 then print_endline "Removed" else prerr_endline "Failed" + | _ -> () + +let peers = function + | Some id -> remove_repo id + | None -> + Printf.printf "Peers in %s\n" Kosuzu.Peers.text_dir; + Kosuzu.Peers.fold print_peer () + +open Cmdliner +let remove = Arg.(value & opt (some string) None & info ["remove"] ~docv:"Repository ID" ~doc:"Remove repository texts and from future pulling") +let peers_t = Term.(const peers $ remove) + +let cmd = + let doc = "List current peers" in + let man = [ + `S Manpage.s_description; + `P "List current peers and associated information" ] + in + let info = Cmd.info "peers" ~doc ~man in + Cmd.v info peers_t diff --git a/trunk/cmd/txt/pull.ml b/trunk/cmd/txt/pull.ml new file mode 100644 index 0000000..7b5766f --- /dev/null +++ b/trunk/cmd/txt/pull.ml @@ -0,0 +1,137 @@ +let writer accum data = + Buffer.add_string accum data; + String.length data + +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; + 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 Kosuzu.File_store.to_text @@ Filename.(concat dir (Kosuzu.Id.short id) ^ ".txt") with + | Error x -> prerr_endline x; true + | Ok txt -> time > (Kosuzu.(Header_pack.date (Date.listing txt.date))) + | exception (Sys_error _) -> true + +let print_peers p = + let open Kosuzu.Header_pack in + match Msgpck.to_list p.peers with [] -> () + | ps -> print_endline @@ + List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps + +type filter_t = { authors: Kosuzu.Person.Set.t; topics: Kosuzu.String_set.t } + +let print_pull_start width total title dir = + Printf.printf "%*d/%s %s => %s %!" width 0 total title dir + +let print_pull width total i = + Printf.printf "\r%*d/%s %!" width (i+1) total + +let printers total title dir = + let width = String.length total in + print_pull_start width total title dir; + print_pull width total + +let fname dir text = Filename.concat dir (Kosuzu.Text.short_id text ^ ".txt") + +let pull_text url dir id = + let u = Filename.concat url ((Kosuzu.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 Kosuzu.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 per_text url dir filter print i id time title authors topics _refs _reps = match id with + | "" -> Printf.eprintf "\nInvalid id for %s\n" title + | id -> let open Kosuzu in + print i; + if newer time id dir + && (String_set.empty = filter.topics + || String_set.exists (fun t -> List.mem t topics) filter.topics) + && (Person.Set.empty = filter.authors + || Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors) + then pull_text url dir id + +let pull_index url authors_opt topics_opt = + let index_url = Filename.concat url "index.pck" in + match curl_pull index_url with + | Error s -> prerr_endline s; false + | Ok body -> + match Kosuzu.Header_pack.of_string (Buffer.contents body) with + | Error s -> Printf.printf "Error with %s: %s\n" url s; false + | Ok pk when pk.info.id = "" -> + Printf.printf "Empty ID index.pck, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_length pk.info.id) -> + Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false + | Ok pk when not (Kosuzu.Validate.validate_id_chars pk.info.id) -> + Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false + | Ok pk -> + let dir = Filename.concat Kosuzu.Peers.text_dir pk.info.id in + Kosuzu.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 ( Kosuzu.Header_pack.string { + pk with info = { pk.info with locations = url::pk.info.locations }}); + close_out file; + let filter = let open Kosuzu in { + authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty); + topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty); + } in + let name = match pk.info.title with "" -> url | title -> title in + let print = printers (string_of_int @@ Kosuzu.Header_pack.numof_texts pk) name dir in + try Kosuzu.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true + with Invalid_argument msg -> Printf.printf "\nFailed to parse %s: %s\n%!" url msg; false + +let pull_list auths topics = + Curl.global_init Curl.CURLINIT_GLOBALALL; + let pull got_one peer_url = if got_one then got_one else + (pull_index peer_url auths topics) in + let open Kosuzu in + let fold_locations init peer = + ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations; + false + in + ignore @@ Peers.fold fold_locations false; + Curl.global_cleanup () + +let pull url auths topics = match url with + | "" -> pull_list auths topics | x -> ignore (pull_index x auths topics) + +open Cmdliner +let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"Comma-separated names" ~doc:"Filter by authors") +let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"Comma-separated topics" ~doc:"Filter by topics") +let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"Repository location") + +let pull_t = Term.(const pull $ url $ authors $ topics) + +let cmd = + let doc = "Pull listed texts" in + let man = [ + `S Manpage.s_description; + `P "Pull texts from known repositories." ] + in + let info = Cmd.info "pull" ~doc ~man in + Cmd.v info pull_t diff --git a/trunk/cmd/txt/recent.ml b/trunk/cmd/txt/recent.ml new file mode 100644 index 0000000..3b46085 --- /dev/null +++ b/trunk/cmd/txt/recent.ml @@ -0,0 +1,23 @@ +open Kosuzu +module FS = File_store +module A = Archive + +open Cmdliner +let recurse = Arg.(value & flag & info ["R"] ~doc: "Recurse into subdirectories") +let reverse = Arg.(value & flag & info ["r"] ~doc: "Reverse order") +let paths = Arg.(value & flag & info ["p"] ~doc: "Show file paths") +let number = Arg.(value & opt (some int) (Some 10) & info ["n"] ~docv: "number" ~doc: "Number of entries to list") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated names" ~doc: "Texts by authors") +let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv: "Comma-separated topics" ~doc: "Texts with topics") +let dir = Arg.(value & pos 0 string "" & info [] ~docv: "Directory to index") + +let recent_t = Term.(const Listing.listing $ recurse $ (const true) $ reverse $ number $ paths $ authed $ topics $ dir) +let cmd = + let doc = "List recent texts" in + let man = [ + `S Manpage.s_description; + `P "List header information of most recent texts."; + `P "If -R is used, list header information for texts found in subdirectories, too, along with their filepaths" ] + in + let info = Cmd.info "recent" ~doc ~man in + Cmd.v info recent_t diff --git a/trunk/cmd/txt/topics.ml b/trunk/cmd/txt/topics.ml new file mode 100644 index 0000000..9c2c936 --- /dev/null +++ b/trunk/cmd/txt/topics.ml @@ -0,0 +1,21 @@ +open Kosuzu +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 recurse = Arg.(value & flag & info ["R"] ~doc: "Include texts in subdirectories") +let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv: "Comma-separated authors" ~doc: "Topics by authors") +let topics_t = Term.(const topics $ recurse $ authed) + +let cmd = + let doc = "List topics" in + let man = [ + `S Manpage.s_description; + `P "List of topics" ] + in + let info = Cmd.info "topics" ~doc ~man in + Cmd.v info topics_t diff --git a/trunk/cmd/txt/txt.ml b/trunk/cmd/txt/txt.ml new file mode 100644 index 0000000..a105d3c --- /dev/null +++ b/trunk/cmd/txt/txt.ml @@ -0,0 +1,36 @@ +open Cmdliner + +let subs = [ + Authors.cmd; + Convert.cmd; + Edit.cmd; + File.cmd; + Index.cmd; + Last.cmd; + Listing.cmd; + New.cmd; + Peers.cmd; + Pull.cmd; + Recent.cmd; + Topics.cmd; + Unfile.cmd; + ] + +let default_cmd = Term.(ret (const (`Help (`Pager, None)))) + +let txt = + let doc = "Discover, collect and exchange texts" in + let man = [ + `S Manpage.s_authors; + `P "orbifx "; + `P "Izuru Yakumo "; + `S Manpage.s_bugs; + `P "Please report them at "; + `S Manpage.s_see_also; + `P "This program is named after Kosuzu Motoori from Touhou Suzunaan: Forbidden Scrollery"; + `P "https://en.touhouwiki.net/wiki/Forbidden_Scrollery" ] + in + Cmd.group (Cmd.info "txt" ~version:"%%VERSION%%" ~doc ~man) ~default:default_cmd subs + +let main () = exit (Cmd.eval txt) +let () = main () diff --git a/trunk/cmd/txt/unfile.ml b/trunk/cmd/txt/unfile.ml new file mode 100644 index 0000000..7d29aef --- /dev/null +++ b/trunk/cmd/txt/unfile.ml @@ -0,0 +1,21 @@ +open Kosuzu + +let unfile files = + let dirs, files = File_store.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 files = Arg.(value & pos_all string [] & info [] ~docv: "Text filenames and subdirectories") + +let unfile_t = Term.(const unfile $ files) + +let cmd = + let doc = "Unfile texts from subdirectories" in + let man = [ + `S Manpage.s_description; + `P "Unfile texts in parameter from directories in parameter, by removing hardlinks" ] + in + let info = Cmd.info "unfile" ~doc ~man in + Cmd.v info unfile_t diff --git a/trunk/cmd/txt_init/dune b/trunk/cmd/txt_init/dune new file mode 100644 index 0000000..6090b4e --- /dev/null +++ b/trunk/cmd/txt_init/dune @@ -0,0 +1,5 @@ +(executable + (name txt_init) + (public_name txt_init) + (modules txt_init) + (libraries kosuzu)) diff --git a/trunk/cmd/txt_init/txt_init.ml b/trunk/cmd/txt_init/txt_init.ml new file mode 100644 index 0000000..30b9c53 --- /dev/null +++ b/trunk/cmd/txt_init/txt_init.ml @@ -0,0 +1,17 @@ +let init_repo = + print_endline "Initializing repository..."; + print_endline "It's required for the repository name and id."; + print_endline "Create one? (y/n)"; + match input_line stdin with + |"y"-> + let title = + print_endline "Title for repository: "; + input_line stdin in + let authors = + print_endline "Authors (format: name ): "; + input_line stdin in + Kosuzu.File_store.file "txt.conf" + (Printf.sprintf "Id:%s\nTitle: %s\nAuthors: %s\n" (Kosuzu.Id.generate ()) title authors); + Kosuzu.File_store.of_kv_file () + | _ -> + print_endline "Aborting..."; exit 1 diff --git a/trunk/dune-project b/trunk/dune-project new file mode 100644 index 0000000..6603f46 --- /dev/null +++ b/trunk/dune-project @@ -0,0 +1,16 @@ +(lang dune 2.0) +(name kosuzu) +(version 1.4.3) +(license EUPL-1.2) +(authors "orbifx ") +(bug_reports "mailto:kosuzu-dev@chaotic.ninja") +(maintainers "Izuru Yakumo ") +(homepage "https://suzunaan.chaotic.ninja/kosuzu/") +(source (uri git+https://git.chaotic.ninja/yakumo.izuru/kosuzu)) + +(generate_opam_files true) + +(package + (name kosuzu) + (synopsis "Texts archival and exchange") + (depends ocaml dune ocurl msgpck cmdliner)) diff --git a/trunk/kosuzu.opam b/trunk/kosuzu.opam new file mode 100644 index 0000000..550e165 --- /dev/null +++ b/trunk/kosuzu.opam @@ -0,0 +1,25 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "1.4.3" +synopsis: "Texts archival and exchange" +maintainer: ["Izuru Yakumo "] +authors: ["orbifx "] +license: "EUPL-1.2" +homepage: "https://suzunaan.chaotic.ninja/kosuzu/" +bug-reports: "mailto:kosuzu-dev@chaotic.ninja" +depends: ["ocaml" "dune" "ocurl" "msgpck" "cmdliner"] +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://git.chaotic.ninja/yakumo.izuru/kosuzu" diff --git a/trunk/lib/archive.ml b/trunk/lib/archive.ml new file mode 100644 index 0000000..a04d660 --- /dev/null +++ b/trunk/lib/archive.ml @@ -0,0 +1,36 @@ +let predicate fn opt = Option.(to_list @@ map fn opt) + +let authored query_string = + let q = Person.Set.of_query @@ String_set.query query_string in + fun n -> Person.Set.predicate q n.Text.authors + +let ided query_string = + let len = String.length query_string in + fun n -> + try String.sub n.Text.id 0 len = query_string + with Invalid_argument _ -> false + +let keyworded query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Keywords" n)) + +let topics query_string = + let q = String_set.query query_string in + fun n -> String_set.(predicate q (Text.set "Topics" n)) + +let apply_sys_util env def_env r order_opt reverse_opt number_opt authors_opt topics_opt id_opt = + let predicates = if id_opt <> "" then [ ided id_opt ] else [] + @ predicate authored authors_opt + @ predicate topics topics_opt in + let predicate text = List.fold_left (fun a e -> a && e text) true predicates in + let util = try Sys.getenv env with Not_found -> def_env in + let print_text acc (_t, fnames) = Printf.sprintf "%s %s" acc (List.hd fnames) in + let paths = match order_opt with + | false -> File_store.fold ~r ~predicate print_text "" + | true -> + let order = match reverse_opt with true -> File_store.newest | false -> File_store.oldest in + match number_opt with + | Some number -> File_store.fold ~r ~predicate ~order ~number print_text "" + | None -> File_store.fold ~r ~predicate ~order print_text "" + in if paths = "" then () + else (ignore @@ Sys.command @@ Printf.sprintf "%s %s" util paths) diff --git a/trunk/lib/category.ml b/trunk/lib/category.ml new file mode 100644 index 0000000..ac807b6 --- /dev/null +++ b/trunk/lib/category.ml @@ -0,0 +1,22 @@ +module Category = struct + type t = Unlisted | Published | Invalid | Custom of string + let compare = Stdlib.compare + let of_string = function "unlisted" | "published" -> Invalid | c -> Custom c + let to_string = function Custom c -> c | _ -> "" +end + +include Category + +module CategorySet = struct + include Set.Make (Category) + let of_stringset s = String_set.fold (fun e a -> add (Category.of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set + let of_string x = of_stringset (String_set.of_string x) + let to_string set = + let f elt a = + let s = Category.to_string elt in + if a <> "" then a ^ ", " ^ s else s + in + fold f set "" +end diff --git a/trunk/lib/date.ml b/trunk/lib/date.ml new file mode 100644 index 0000000..6eab0d9 --- /dev/null +++ b/trunk/lib/date.ml @@ -0,0 +1,22 @@ +type t = { created: string; edited: string } +let compare = compare +let rfc_string date = date +let of_string (rfc : string) = rfc +let listing date = if date.edited <> "" then date.edited else date.created +let months = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|] +let pretty_date date = + try Scanf.sscanf date "%4s-%d-%2s" (fun y m d -> Printf.sprintf "%s %s, %s" d (months.(m-1)) y) + with + | Scanf.Scan_failure s as e -> Printf.fprintf stderr "%s for %s\n" s date; raise e + | Invalid_argument _s as e -> Printf.fprintf stderr "Parsing %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) +let of_secs s = + let { Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours; + tm_mday=day; tm_mon=month; tm_year=year; _ } = Unix.localtime (float_of_int s) in + Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02d" + (year+1900) (month+1) day hours minutes seconds diff --git a/trunk/lib/dune b/trunk/lib/dune new file mode 100644 index 0000000..119bdd5 --- /dev/null +++ b/trunk/lib/dune @@ -0,0 +1,4 @@ +(library + (name kosuzu) + (public_name kosuzu) + (libraries text_parse text_parse.parsers unix str msgpck)) diff --git a/trunk/lib/file_store.ml b/trunk/lib/file_store.ml new file mode 100644 index 0000000..89afa21 --- /dev/null +++ b/trunk/lib/file_store.ml @@ -0,0 +1,150 @@ +type t = string +type item_t = t list +type record_t = Text.t * item_t + +let extension = ".txt" + +let txtdir () = try Sys.getenv "TXTDIR" with Not_found -> + let share = Filename.concat (Sys.getenv "HOME") ".local/share/texts/" in + match Sys.is_directory share with true -> share + | false | exception (Sys_error _) -> "." + +let cfgpath () = match "txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> match Filename.concat (Sys.getenv "HOME") ".config/txt/txt.conf" with + | filepath when Sys.file_exists filepath -> filepath + | _ -> "" + +let to_string f = + let ic = open_in f in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + s + +let fold_file_line fn init file = match open_in file with + | 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 file path str = let o = open_out path in output_string o str; close_out o + +let to_text path = + if Filename.extension path = extension then + (to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m)) + else Error (Printf.sprintf "Not txt: %s" path) + +let newest (a,_pa) (b,_pb) = Text.newest a b +let oldest (a,_pa) (b,_pb) = Text.oldest a b + +let list_iter fn dir paths = + let link f = match to_text (Filename.concat dir f) with + | Ok t -> fn dir t f | Error s -> prerr_endline s in + List.iter link paths + +module TextMap = Map.Make(Text) + +type iteration_t = item_t TextMap.t +let new_iteration = TextMap.empty + +(*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 + +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 + +(* 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 + | f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result + | f::fs -> loop (f::result) fs + | [] -> result in + let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else + if not r then expand_dir dir else [dir] in + loop [] dirs + +let list_take n = + let rec take acc n = function [] -> [] + | x::_ when n = 1 -> x::acc + | x::xs -> take (x::acc) (n-1) xs + in take [] n + +let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist = + (match number with None -> (fun x -> x) | Some n -> list_take n) + @@ List.fast_sort comp @@ TextMap.bindings + @@ List.fold_left (fold_valid_text predicate) new_iteration flist + +let iter ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn = + let flist = list_fs ~r dir in match order with + | Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist + | None -> List.iter fn @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let fold ?(r=false) ?(dir=txtdir ()) ?(predicate=fun _ -> true) ?order ?number fn acc = + let flist = list_fs ~r dir in match order with + | Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist + | None -> List.fold_left fn acc @@ TextMap.bindings @@ + List.fold_left (fold_valid_text predicate) new_iteration flist + +let with_dir ?(descr="") ?(perm=0o740) dir = + let mkdir dir = match Unix.mkdir dir perm with + | exception Unix.Unix_error (EEXIST, _, _) -> () + | exception Unix.Unix_error (code, _fn, arg) -> + failwith @@ Printf.sprintf "Error %s making %s dir: %s" + (Unix.error_message code) descr arg + | _ -> () in + 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 rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl + +let versioned_basename_of_title ?(version=0) repo extension (title : string) = + let basename = Text.string_alias title in + let rec next version = + let candidate = Filename.concat repo + (basename ^ "." ^ string_of_int version ^ extension) in + if Sys.file_exists candidate then next (succ version) else candidate + in + next version + +let id_filename repo extension text = + let description = match Text.alias text with "" -> "" | x -> "." ^ x in + let candidate = Filename.concat repo (text.id ^ description ^ extension) in + if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate + +let with_text ?(dir=txtdir ()) new_text = + match id_filename dir extension new_text with + | Error _ as e -> e + | Ok path -> + try file path (Text.to_string new_text); Ok (path, new_text) + with Sys_error s -> Error s + +module Config = struct + type t = string Store.KV.t + let key_value k v a = Store.KV.add k (String.trim v) a +end + +let of_kv_file ?(path=cfgpath ()) () = + let open Text_parse in + let subsyntaxes = Parsers.Key_value.[| + (module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in + let of_string text acc = + Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in + if path <> "" then of_string (to_string @@ path) Store.KV.empty + else Store.KV.empty diff --git a/trunk/lib/header_pack.ml b/trunk/lib/header_pack.ml new file mode 100644 index 0000000..1de60e1 --- /dev/null +++ b/trunk/lib/header_pack.ml @@ -0,0 +1,133 @@ +let version = 0 +type info_t = { version: int; id: string; title: string; people: string list; locations: string list } +type t = { info: info_t; fields: Msgpck.t; texts: Msgpck.t; peers: Msgpck.t } + +let of_id id = Msgpck.of_string id +let to_id = Msgpck.to_string + +let person p = Msgpck.String (Person.to_string p) +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 + (try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e) + +let of_set field t = + List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) [] + +let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date) + +let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x + +let fields = Msgpck.(List [ + String "id"; String "time"; String "title"; String "authors"; String "topics"; + String "references"; String "replies"; + ]) +let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack) + +let to_info = function + | Msgpck.List (v::id::n::a::ls::[]) -> + let people = to_str_list a in + 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" + +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); + List (of_set "references" t); + List (of_set "in-reply-to" 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 + | Msgpck.List (i::fields::texts::[]) -> + Ok { info = to_info i; fields; texts; peers = Msgpck.List [] } + | Msgpck.List (i::fields::texts::peers::[]) -> + Ok { info = to_info i; fields; texts; peers } + | _ -> Error "format mismatch" + +let of_string s = unpack @@ snd @@ Msgpck.StringBuf.read s + +let of_kv kv = + let find k kv = try Store.KV.find k kv with Not_found -> "" in + let find_ls k kv = try String_set.list_of_csv (Store.KV.find k kv) with Not_found -> [] in + { + info = { version = version; id = find "Id" kv; title = find "Title" kv; + people = find_ls "Authors" kv; locations = find_ls "Locations" kv }; + fields; + texts = Msgpck.List []; + peers = str_list (find_ls "Peers" kv); + } + +let list filename = try + let texts_list = function + | Msgpck.List (_info :: _fields :: [texts]) -> Msgpck.to_list texts + | _ -> prerr_endline "malformed feed"; [] in + let _pos, data = Msgpck.StringBuf.read @@ File_store.to_string filename in + Ok (texts_list data) + with Not_found -> Error "unspecified export dir" + +let contains text = function + | Msgpck.List (id::_time::title::_authors::_topics::[]) -> + (match to_id id with + | "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false + | id -> text.Text.id = id) + | _ -> prerr_endline ("Invalid record pattern"); false + +let numof_texts pack = List.length (Msgpck.to_list pack.texts) + +let txt_iter_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = + try begin match extra with [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end with e -> prerr_endline "iter ref reps"; raise e + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x) + +let txt_fold_apply fn i = function + | Msgpck.List (id::time::title::authors::topics::extra) -> + let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i + | x -> Msgpck.to_uint32 x in + let id = to_id id in + let title = Msgpck.to_string title in + let topics = to_str_list topics in + let authors = to_str_list authors in + let references, replies = begin match extra with + | [] -> [], [] + | refs::[] -> to_str_list refs, [] + | refs::replies::_xs -> to_str_list refs, to_str_list replies + end + in + fn i id t title authors topics references replies + | x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i + +let iteri fn pack = List.iteri + (txt_iter_apply fn) + (Msgpck.to_list pack.texts) + +let fold fn init pack = List.fold_left + (fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init + (try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e) diff --git a/trunk/lib/id.ml b/trunk/lib/id.ml new file mode 100644 index 0000000..fe494d6 --- /dev/null +++ b/trunk/lib/id.ml @@ -0,0 +1,22 @@ +let random_state = Random.State.make_self_init + +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 diff --git a/trunk/lib/peers.ml b/trunk/lib/peers.ml new file mode 100644 index 0000000..8b2ae69 --- /dev/null +++ b/trunk/lib/peers.ml @@ -0,0 +1,25 @@ +let text_dir = Filename.concat (File_store.txtdir ()) "peers" + +type t = { path: string; pack: Header_pack.t } + +let fold fn init = match Sys.readdir text_dir with + | exception (Sys_error msg) -> prerr_endline msg; init + | dirs -> + let read_pack init path = + let fullpath = Filename.concat text_dir path in + if Sys.is_directory fullpath then begin + let pack_path = Filename.concat fullpath "index.pck" in + match Sys.file_exists pack_path with + | false -> Printf.eprintf "Missing index.pck for %s\n" path; init + | true -> match Header_pack.of_string (File_store.to_string pack_path) with + | Error s -> Printf.eprintf "%s %s\n" s pack_path; init + | Ok pack -> fn init { path; pack } + end else init + in + Array.fold_left read_pack init 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 diff --git a/trunk/lib/person.ml b/trunk/lib/person.ml new file mode 100644 index 0000000..e2f3597 --- /dev/null +++ b/trunk/lib/person.ml @@ -0,0 +1,32 @@ +module Person = struct + type name_t = string + type address_t = string + type t = { name: name_t; addresses: address_t list } + let empty = { name = ""; addresses = [] } + let compare = Stdlib.compare + 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 -> + match Str.(split (regexp " *< *") s) with + | [] -> empty + | [n] -> let name = String.trim n in { empty with name } + | n::adds -> + let name = String.trim n in + let addresses = List.map (fun f -> String.(sub f 0 (length f -1))) adds in + { name; addresses } +end + +include Person + +module Set = struct + include Set.Make(Person) + let to_string ?(names_only=false) ?(pre="") ?(sep=", ") s = + 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 + fold j s pre + let of_string s = of_list (List.map Person.of_string (String_set.list_of_csv s)) + + let of_stringset s = String_set.fold (fun e a -> union (of_string e) a) s empty + let of_query q = of_stringset (fst q), of_stringset (snd q) + let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set +end diff --git a/trunk/lib/reference_set.ml b/trunk/lib/reference_set.ml new file mode 100644 index 0000000..6c456ec --- /dev/null +++ b/trunk/lib/reference_set.ml @@ -0,0 +1 @@ +module Map = Map.Make(String) diff --git a/trunk/lib/store.ml b/trunk/lib/store.ml new file mode 100644 index 0000000..a0d435f --- /dev/null +++ b/trunk/lib/store.ml @@ -0,0 +1,16 @@ +module KV = Map.Make (String) + +module type T = sig + type t + type item_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 + val of_path: string -> (archive_t, string) result + val newest: record_t -> record_t -> int + val oldest: record_t -> record_t -> int + val with_text: archive_t -> Text.t -> (string * Text.t, string) result + val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> (record_t -> unit) -> archive_t -> unit + val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int + -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a +end diff --git a/trunk/lib/string_set.ml b/trunk/lib/string_set.ml new file mode 100644 index 0000000..fca4fc1 --- /dev/null +++ b/trunk/lib/string_set.ml @@ -0,0 +1,20 @@ +include Set.Make(String) + +let list_of_csv x = Str.(split (regexp " *, *")) (String.trim x) +let list_of_ssv x = Str.(split (regexp " +")) (String.trim x) + +let of_string ?(separator=list_of_csv) x = of_list (separator x) +let of_csv_string x = of_string ~separator:list_of_csv x +let of_ssv_string x = of_string ~separator:list_of_ssv x + +let to_string ?(pre="") ?(sep=", ") s = + let j a x = match a, x with "", _ -> x | _, "" -> a | _ -> a ^ sep ^ x in + fold (fun x acc -> j acc x) s pre + +let query string = + let partition (include_set, exclude_set) elt = + if String.get elt 0 = '!' then (include_set, add String.(sub elt 1 (length elt - 1)) exclude_set) + else (add elt include_set, exclude_set) in + List.fold_left partition (empty, empty) @@ list_of_csv string + +let predicate (inc, exl) set = not (disjoint inc set) && disjoint exl set diff --git a/trunk/lib/text.ml b/trunk/lib/text.ml new file mode 100644 index 0000000..80fb192 --- /dev/null +++ b/trunk/lib/text.ml @@ -0,0 +1,122 @@ +module String_map = Map.Make (String) +type t = { + id: Id.t; + title: string; + authors: Person.Set.t; + date: Date.t; + string_map: string String_map.t; + stringset_map: String_set.t String_map.t; + body: string; + } + +let blank ?(id=(Id.generate ())) () = { + id; + title = ""; + authors = Person.Set.empty; + date = Date.({ created = now (); edited = ""}); + string_map = String_map.empty; + stringset_map = String_map.empty; + body = ""; + } + +let compare = Stdlib.compare +let newest a b = Date.(compare a.date b.date) +let oldest a b = Date.(compare b.date a.date) + +let str key m = + try String_map.find (String.lowercase_ascii key) m.string_map + with Not_found -> "" + +let set key m = + try String_map.find (String.lowercase_ascii key) m.stringset_map + with Not_found -> String_set.empty + +let with_str_set ?(separator=String_set.of_csv_string) m key str = + { m with + stringset_map = String_map.add (String.lowercase_ascii key) (separator str) + m.stringset_map + } + +let with_kv x (k,v) = + let trim = String.trim in + match String.lowercase_ascii k with + | "body" -> { x with body = String.trim v } + | "title"-> { x with title = trim v } + | "id" -> (match v with "" -> x | s -> { x with id = s }) + | "author" + | "authors" -> { x with authors = Person.Set.of_string (trim 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 }} + | "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v + | "references" | "in-reply-to" -> with_str_set + ~separator:(fun x -> String_set.map + (fun x -> String.(sub x 1 (length x-2))) (String_set.of_ssv_string x)) + x k v + | k -> { x with string_map = String_map.add k (trim v) x.string_map } + +let kv_of_string line = match Str.(bounded_split (regexp ": *")) line 2 with + | [ key; value ] -> Str.(replace_first (regexp "^#\\+") "" key), value + | [ key ] -> Str.(replace_first (regexp "^#\\+") "" key), "" + | _ -> "","" + +let of_header front_matter = + let fields = List.map kv_of_string (Str.(split (regexp "\n")) front_matter) in + List.fold_left with_kv (blank ~id:Id.nil ()) fields + +let front_matter_body_split s = + if Str.(string_match (regexp ".*:.*")) s 0 + then match Str.(bounded_split (regexp "^$")) s 2 with + | front::body::[] -> (front, body) + | _ -> ("", s) + else ("", s) + +let of_string s = + let front_matter, body = front_matter_body_split s in + try + let note = { (of_header front_matter) with body } in + if note.id <> Id.nil then Ok note else Error "Missing ID header" + with _ -> Error ("Failed parsing" ^ s) + +let str_set key m = String_set.to_string @@ set key m + +let to_string x = + let has_len v = String.length v > 0 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 d field value = match value with "" -> "" + | s -> field ^ ": " ^ Date.rfc_string s ^ "\n" in + let rows = [ + s "ID" x.id; + d "Date" x.date.Date.created; + d "Edited" x.date.Date.edited; + s "Title" x.title; + a x.authors; + s "Licences" (str_set "licences" x); + s "Topics" (str_set "topics" x); + s "Keywords" (str_set "keywords" x); + s "References"(str_set "references" x); (*todo: add to output <>*) + s "In-Reply-To"(str_set "in-reply-to" x); + s "Series" (str_set "series" x); + s "Abstract" (str "abstract" x); + s "Alias" (str "Alias" x) + ] in + String.concat "" rows ^ "\n" ^ x.body + +let string_alias t = + let is_reserved = function + | '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$' + | ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true + | _ -> false + in + let b = Buffer.create (String.length t) in + let filter char = + 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") + else add_char b char + in + String.(iter filter (lowercase_ascii t)); + Buffer.contents b + +let alias t = match str "alias" t with "" -> string_alias t.title | x -> x +let short_id t = Id.short t.id diff --git a/trunk/lib/topic_set.ml b/trunk/lib/topic_set.ml new file mode 100644 index 0000000..0e723e6 --- /dev/null +++ b/trunk/lib/topic_set.ml @@ -0,0 +1,35 @@ +let of_string x = Str.(split (regexp " *> *")) (String.trim x) + +let topic x = + let path = of_string x in + try List.nth path (List.length path - 1) with _ -> "" + +module Map = Map.Make(String) + +let edges x map = try Map.find x map with Not_found -> (String_set.empty, String_set.empty) + +let edges_with_context context (contexts, subtopics) = (String_set.add context contexts, subtopics) +let edges_with_subtopic subtopic (contexts, subtopics) = (contexts, String_set.add subtopic subtopics) + +let rec list_to_map map = function + | [] -> map + | [topic] -> + let edges = edges topic map in + Map.add topic edges map + | context :: topic :: tail -> + let context_edges = edges context map in + let topic_edges = edges topic map in + let map = + map + |> Map.add context (edges_with_subtopic topic context_edges) + |> Map.add topic (edges_with_context context topic_edges) + in + list_to_map map (topic :: tail) + +let to_map map set = + List.fold_left (fun acc elt -> list_to_map acc (of_string elt)) map @@ String_set.elements set + +let roots map = + let root_keys acc (key, (contexts, _topics)) = if String_set.is_empty contexts then key :: acc else acc in + List.fold_left root_keys [] @@ Map.bindings map + diff --git a/trunk/lib/validate.ml b/trunk/lib/validate.ml new file mode 100644 index 0000000..5ee17bd --- /dev/null +++ b/trunk/lib/validate.ml @@ -0,0 +1,5 @@ +let validate_id_length s = String.length s <= 32 +let validate_id_chars s = try + String.iter (function 'a'..'z'|'A'..'Z'|'0'..'9'-> () | _ -> raise (Invalid_argument "")) s; + true + with Invalid_argument _ -> false