robur/git-kv
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request 'fix mgit rng initialization, add mgit mtime command' (!9) from mgit-mtime into main

Browse source 
Reviewed-on: #9
This commit is contained in:
Reynir Björnsson 2024-12-19 13:30:01 +00:00
commit a6ebf32529
2 changed files with 17 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
app/dune
View file

@ -1,3 +1,3 @@
(executable (executable
(name mgit) (name mgit)
(libraries mirage-clock-unix logs.fmt fmt.tty git-unix git-kv)) (libraries mirage-clock-unix logs.fmt fmt.tty git-unix git-kv mirage-crypto-rng.unix))

16
app/mgit.ml
View file

@ -82,6 +82,15 @@ let list ~quiet store key =
if not quiet then Fmt.epr "%a.\n%!" Store.pp_error err ; if not quiet then Fmt.epr "%a.\n%!" Store.pp_error err ;
Lwt.return (Ok 1) Lwt.return (Ok 1)
let last_modified ~quiet store key =
Store.last_modified store key >>= function
| Ok time ->
Fmt.pr "%a\n%!" Ptime.pp time;
Lwt.return (Ok 0)
| Error err ->
if not quiet then Fmt.epr "%a.\n%!" Store.pp_error err ;
Lwt.return (Ok 1)
let pull ~quiet store = let pull ~quiet store =
Git_kv.pull store >>= function Git_kv.pull store >>= function
| Error (`Msg err) -> if not quiet then Fmt.epr "%s.\n%!" err ; Lwt.return (Ok 1) | Error (`Msg err) -> if not quiet then Fmt.epr "%s.\n%!" err ; Lwt.return (Ok 1)
@ -134,6 +143,9 @@ let repl store fd_in =
| [ "list"; key; ] -> | [ "list"; key; ] ->
with_key ~f:(list ~quiet:false store0) key with_key ~f:(list ~quiet:false store0) key
>|= ignore >>= fun () -> go store0 >|= ignore >>= fun () -> go store0
| [ "mtime"; key; ] ->
with_key ~f:(last_modified ~quiet:false store0) key
>|= ignore >>= fun () -> go store0
| [ "pull"; ] -> | [ "pull"; ] ->
if is_a_tty then Fmt.pr "\n%!" ; pull ~quiet:false store0 if is_a_tty then Fmt.pr "\n%!" ; pull ~quiet:false store0
>|= ignore >>= fun () -> go store0 >|= ignore >>= fun () -> go store0
@ -169,6 +181,10 @@ let run remote = function
| Ok t -> repl t Unix.stdin | Ok t -> repl t Unix.stdin
| Error (`Msg err) -> Fmt.failwith "%s." err ) | Error (`Msg err) -> Fmt.failwith "%s." err )
let run remote filename_opt =
let () = Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna) in
run remote filename_opt
let () = match Sys.argv with let () = match Sys.argv with
| [| _; remote; |] -> run remote None | [| _; remote; |] -> run remote None
| [| _; remote; filename; |] when Sys.file_exists filename -> | [| _; remote; filename; |] when Sys.file_exists filename ->