source: code/trunk/cli/pull.ml@ 59

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 _refs _reps = 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 open Logarion in
        let fold_locations init peer =
                ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations;
                false
        in
        ignore @@ Peers.fold fold_locations false;
        Curl.global_cleanup ()

let pull url auths topics = match url with
        | "" -> 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*)