161 lines
6.1 KiB
OCaml
161 lines
6.1 KiB
OCaml
let writer accum data =
|
|
Buffer.add_string accum data;
|
|
String.length data
|
|
|
|
let showContent content =
|
|
Printf.printf "%s" (Buffer.contents content);
|
|
flush stdout
|
|
|
|
let showInfo connection =
|
|
Printf.printf "Time: %f for: %s\n"
|
|
(Curl.get_totaltime connection)
|
|
(Curl.get_effectiveurl connection)
|
|
|
|
let getContent connection url =
|
|
Curl.set_url connection url;
|
|
Curl.perform connection
|
|
|
|
let curl_pull url =
|
|
let result = Buffer.create 4069
|
|
and errorBuffer = ref "" in
|
|
let connection = Curl.init () in
|
|
try
|
|
Curl.set_errorbuffer connection errorBuffer;
|
|
Curl.set_writefunction connection (writer result);
|
|
Curl.set_followlocation connection true;
|
|
Curl.set_url connection url;
|
|
Curl.perform connection;
|
|
(* showContent result;*)
|
|
(* showInfo connection;*)
|
|
Curl.cleanup connection;
|
|
Ok result
|
|
with
|
|
| Curl.CurlException (_reason, _code, _str) ->
|
|
Curl.cleanup connection;
|
|
Error (Printf.sprintf "Error: %s %s" url !errorBuffer)
|
|
| Failure s ->
|
|
Curl.cleanup connection;
|
|
Error (Printf.sprintf "Caught exception: %s" s)
|
|
|
|
let newer time id dir =
|
|
match Logarion.File_store.to_text @@ Filename.(concat dir (Logarion.Id.short id) ^ ".txt") with
|
|
| Error x -> prerr_endline x; true
|
|
| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date)))
|
|
| exception (Sys_error _) -> true
|
|
|
|
let print_peers p =
|
|
let open Logarion.Header_pack in
|
|
match Msgpck.to_list p.peers with [] -> ()
|
|
| ps -> print_endline @@
|
|
List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps
|
|
|
|
let parse_index _is_selected fn url dir p =
|
|
let open Logarion.Header_pack in
|
|
match Msgpck.to_list p.texts with
|
|
| [] -> Printf.printf "%s => %s, has empty index\n" p.info.title dir; false
|
|
| texts ->
|
|
let numof_texts = string_of_int @@ List.length texts in
|
|
let text_num_len = String.length numof_texts in
|
|
Printf.printf "%*d/%s %s => %s\r" text_num_len 0 numof_texts p.info.title dir;
|
|
let of_pck i x =
|
|
Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts;
|
|
match x with
|
|
| Msgpck.List (id::time::title::_authors::_topics) ->
|
|
(match Logarion.Header_pack.to_id id with
|
|
| "" -> Printf.eprintf "Invalid id for%s " (Msgpck.to_string title)
|
|
| id ->
|
|
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in
|
|
if newer t id dir then fn url dir id)
|
|
| _ -> prerr_endline ("Invalid record structure") in
|
|
List.iteri of_pck texts;
|
|
print_newline ();
|
|
true
|
|
|
|
let fname dir text = Filename.concat dir (Logarion.Text.short_id text ^ ".txt")
|
|
let pull_text url dir id =
|
|
let u = Filename.concat url ((Logarion.Id.short id) ^ ".txt") in
|
|
match curl_pull u with
|
|
| Error msg -> Printf.eprintf "Failed getting %s: %s" u msg
|
|
| Ok txt ->
|
|
let txt = Buffer.contents txt in
|
|
match Logarion.Text.of_string txt with
|
|
| Error s -> prerr_endline s
|
|
| Ok text ->
|
|
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in
|
|
output_string file txt; close_out file
|
|
|
|
let pull_index url _authors _topics =
|
|
let index_url = url ^ "/index.pck" in
|
|
match curl_pull index_url with
|
|
| Error s -> prerr_endline s; false
|
|
| Ok body ->
|
|
match Logarion.Header_pack.of_string (Buffer.contents body) with
|
|
| Error s -> Printf.printf "Error with %s: %s\n" url s; false
|
|
| Ok pk ->
|
|
let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in
|
|
Logarion.File_store.with_dir dir;
|
|
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (Filename.concat dir "index.pck") in
|
|
output_string file ( Logarion.Header_pack.string {
|
|
pk with info = { pk.info with locations = url::pk.info.locations }});
|
|
close_out file;
|
|
(* let predicates = A.predicate A.authored authors_opt*)
|
|
(* @ A.predicate A.topics topics_opt in*)
|
|
let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in
|
|
try parse_index is_selected pull_text url dir pk with
|
|
Invalid_argument msg -> Printf.eprintf "Failed to parse: %s\n%!" msg; false
|
|
|
|
let pull_list auths topics =
|
|
Curl.global_init Curl.CURLINIT_GLOBALALL;
|
|
let pull got_one peer_url = if got_one then got_one else
|
|
(pull_index peer_url auths topics) in
|
|
Logarion.Peers.fold pull false;
|
|
Curl.global_cleanup ()
|
|
|
|
let pull url auths topics = match url with
|
|
| "" -> pull_list auths topics | x -> ignore (pull_index x auths topics)
|
|
|
|
open Cmdliner
|
|
let term =
|
|
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"]
|
|
~docv:"comma-separated names" ~doc:"filter by authors") in
|
|
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"]
|
|
~docv:"comma-separated topics" ~doc:"filter by topics") in
|
|
let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL"
|
|
~doc:"Repository location") in
|
|
Term.(const pull $ url $ authors $ topics),
|
|
Term.info "pull" ~doc:"pull listed texts" ~man:[ `S "DESCRIPTION";
|
|
`P "Pull texts from known repositories. To add a new repository use:";
|
|
`P "txt pull [url]";
|
|
`P ("This creates a directory in " ^ Logarion.Peers.text_dir
|
|
^ " and downloads the text index.pck file in it")]
|
|
|
|
(*module Msg = struct*)
|
|
(* type t = string * string*)
|
|
(* let compare (x0,y0) (x1,y1) =*)
|
|
(* match compare x1 x0 with 0 -> String.compare y0 y1 | c -> c*)
|
|
(*end*)
|
|
(*module MsgSet = Set.Make(Msg)*)
|
|
(*let pull_msgs url _authors _topics =*)
|
|
(* match http_apply response url with*)
|
|
(* | Error msg ->*)
|
|
(* Printf.eprintf "Failed index request for %s %s" url msg*)
|
|
(* | Ok body ->*)
|
|
(* let rec fold_msgs s a fn =*)
|
|
(* let t, msg = Scanf.bscanf s "%s %s@\n" (fun t m -> t, m) in*)
|
|
(* if t <> "" then fold_msgs s (fn a t msg) fn else a*)
|
|
(* in*)
|
|
(* let s = Scanf.Scanning.from_string body in*)
|
|
(* let msgs = MsgSet.empty in*)
|
|
(* let date_string t = Ptime.to_date t |>*)
|
|
(* fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d in*)
|
|
(* let msgs = fold_msgs s msgs*)
|
|
(* (fun msgs t m -> match Ptime.of_rfc3339 t with*)
|
|
(* | Ok (v,_,_) -> let open MsgSet in*)
|
|
(* let msgs = if cardinal msgs > 1 then remove (max_elt msgs) msgs else msgs in*)
|
|
(* add (v,m) msgs*)
|
|
(* | _ -> msgs) in*)
|
|
(* let msg_string = MsgSet.fold*)
|
|
(* (fun (t,m) a -> a ^ Printf.sprintf " %s 𐄁 %s\n" (date_string t) m)*)
|
|
(* msgs "" in*)
|
|
(* Printf.printf "┌───{ %s }───┐\n%s" url msg_string*)
|