software-archive/logarion-2021
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix to_uint32 issue on amd64 architectures

Browse Source
This commit is contained in:
orbifx 2021-09-22 18:29:40 +01:00
parent fac264c09f
commit c8a0ce481b
2 changed files with 26 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
http/http.ml
View File

@ -52,25 +52,28 @@ let parse_index _is_selected fn url = function
in
print_endline @@ archive_name ^ " (pack format version " ^ string_of_int version ^ ")";
(match Msgpck.to_list texts with
| [] -> prerr_endline "Empty index"
| texts ->
(try Unix.mkdir "peers" 0o740 with Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
let dir = "peers/" ^ match Uri.host url with
| None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
(match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
| Ok _ -> ()
| _ -> prerr_endline "Error making domain dir");
print_endline @@ "Copying into: " ^ dir;
let text_num = List.length texts in
let of_pck i x =
print_string @@ "\rDownloading " ^ string_of_int (i+1) ^ "/" ^ string_of_int text_num; flush stdout;
match x with
| Msgpck.List (id::time::title::_authors::_topics) ->
(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title)
| Some id -> if newer Msgpck.(to_uint32 time) id dir then fn url dir id)
| _ -> prerr_endline ("Invalid record structure")
in List.iteri of_pck texts)
| [] -> prerr_endline "Empty index"
| texts ->
(try Unix.mkdir "peers" 0o740 with Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
let dir = "peers/" ^ match Uri.host url with
| None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
(match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
| Ok _ -> ()
| _ -> prerr_endline "Error making domain dir");
print_endline @@ "Copying into: " ^ dir;
let text_num = List.length texts in
let of_pck i x =
print_string @@ "\rDownloading " ^ string_of_int (i+1) ^ "/" ^ string_of_int text_num ^ " "; flush stdout;
match x with
| Msgpck.List (id::time::title::_authors::_topics) ->
(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title)
| Some id ->
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in
if newer t id dir then fn url dir id)
| _ -> prerr_endline ("Invalid record structure") in
List.iteri of_pck texts;
print_newline ())
| _ -> prerr_endline "malformed feed"
let pull_index url _authors _topics =

10
lib/header_pack.ml
View File

@ -13,15 +13,13 @@ let date = function
Int32.add Int32.(mul (of_int days) 86400l) Int64.(to_int32 (div ps 1000000000000L))
let columns = Msgpck.(List
[String "id"; String "time"; String "title";
String "authors"; String "topics"])
[String "id"; String "time"; String "title"; String "authors"; String "topics"])
let to_pack a t =
let open Text in
Msgpck.(List [Bytes (Id.to_bytes t.uuid);
of_uint32 (date (Date.listing t.date));
String t.title; List (persons t.authors);
List (of_set "topics" t)]) :: a
Msgpck.(List [
Bytes (Id.to_bytes t.uuid); of_uint32 (date (Date.listing t.date));
String t.title; List (persons t.authors); List (of_set "topics" t)]) :: a
let pack_filename ?(filename="index.pck") archive =
let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)