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 type filter_t = { authors: Logarion.Person.Set.t; topics: Logarion.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 (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 per_text url dir filter print i id time title authors topics = match id with | "" -> Printf.eprintf "\nInvalid id for %s\n" title | id -> let open Logarion 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 (*TODO: integrate in lib*) let validate_id_length s = String.length s <= 32 let validate_id_chars s = try String.iter (function 'a'..'z'|'A'..'Z'|'0'..'9'-> () | _ -> raise (Invalid_argument "")) s; true with Invalid_argument _ -> false let pull_index url authors_opt topics_opt = let index_url = Filename.concat url "index.pck" in match curl_pull index_url with | Error s -> prerr_endline s; false | Ok body -> match Logarion.Header_pack.of_string (Buffer.contents body) with | Error s -> Printf.printf "Error with %s: %s\n" url s; false | Ok pk when pk.info.id = "" -> Printf.printf "Empty ID index.pck, skipping %s\n" url; false | Ok pk when not (validate_id_length pk.info.id) -> Printf.printf "Index pack ID longer than 32 characters, skipping %s\n" url; false | Ok pk when not (validate_id_chars pk.info.id) -> Printf.printf "Index pack contains invalid ID characters, skipping %s\n" url; false | Ok pk -> let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in Logarion.File_store.with_dir dir; 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 filter = let open Logarion 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 @@ Logarion.Header_pack.numof_texts pk) name dir in try Logarion.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true with Invalid_argument msg -> Printf.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 fold_locations init peer = ignore @@ List.fold_left pull init peer.Logarion.Peers.locations; false in ignore @@ Logarion.Peers.fold fold_locations false; Curl.global_cleanup () let pull url auths topics = match url with | "" -> 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*)