commit: de35a48b093cf758bc249866e21ec6ad56ddb6b8
Author: Alessandro Barbieri <lssndrbarbieri <AT> gmail <DOT> com>
AuthorDate: Sat Apr 9 13:55:46 2022 +0000
Commit: Alessandro Barbieri <lssndrbarbieri <AT> gmail <DOT> com>
CommitDate: Fri Apr 15 20:34:20 2022 +0000
URL: https://gitweb.gentoo.org/repo/proj/guru.git/commit/?id=de35a48b
dev-ml/shared-block-ring: initial import
Signed-off-by: Alessandro Barbieri <lssndrbarbieri <AT> gmail.com>
dev-ml/shared-block-ring/Manifest | 1 +
.../files/shared-block-ring-3.0.0-PR-62.patch | 318 +++++++++++++++++++++
dev-ml/shared-block-ring/metadata.xml | 11 +
.../shared-block-ring-3.0.0.ebuild | 41 +++
4 files changed, 371 insertions(+)
diff --git a/dev-ml/shared-block-ring/Manifest
b/dev-ml/shared-block-ring/Manifest
new file mode 100644
index 000000000..df7364e52
--- /dev/null
+++ b/dev-ml/shared-block-ring/Manifest
@@ -0,0 +1 @@
+DIST shared-block-ring-3.0.0.tar.gz 18503 BLAKE2B
786997d650a9094068822ba0b214e8e26658c8caaa26a0bc28f504bdf18f5f07a69896aae46ead9d337db1c7272d8198ed37b8e573e66c7e13ebd56bf94a96d8
SHA512
1f16926aaf641bcfb285d6047cb45b271c4bbb70b345aa803b51f8f966f7815a2890f6993f449aadb11c254f05064f6469cedb9020074c5a566eb6a4ca9d2a6e
diff --git a/dev-ml/shared-block-ring/files/shared-block-ring-3.0.0-PR-62.patch
b/dev-ml/shared-block-ring/files/shared-block-ring-3.0.0-PR-62.patch
new file mode 100644
index 000000000..90b185afd
--- /dev/null
+++ b/dev-ml/shared-block-ring/files/shared-block-ring-3.0.0-PR-62.patch
@@ -0,0 +1,318 @@
+From 4c8fb45a201cd15aa038d84bd792679a31bec5a8 Mon Sep 17 00:00:00 2001
+From: Hannes Mehnert <han...@mehnert.org>
+Date: Thu, 27 Jan 2022 16:24:42 +0100
+Subject: [PATCH 1/3] avoid deprecated Cstruct.len, use Cstruct.length instead
+
+--- a/lib/eraseBlock.ml
++++ b/lib/eraseBlock.ml
+@@ -23,14 +23,14 @@ module Make(B: S.BLOCK) = struct
+ >>= fun info ->
+ let pages = Io_page.get block_size_pages in
+ let buffer = Io_page.to_cstruct pages in
+- for i = 0 to Cstruct.len buffer - 1 do
++ for i = 0 to Cstruct.length buffer - 1 do
+ Cstruct.set_char buffer i (pattern.[i mod (String.length pattern)])
+ done;
+ let rec loop n =
+ if n = info.Mirage_block.size_sectors
+ then return (Ok ())
+ else
+- let buffer_in_sectors = Cstruct.len buffer /
info.Mirage_block.sector_size in
++ let buffer_in_sectors = Cstruct.length buffer /
info.Mirage_block.sector_size in
+ let needed = Int64.to_int (min (Int64.sub
info.Mirage_block.size_sectors n) (Int64.of_int buffer_in_sectors)) in
+ let towrite = Cstruct.sub buffer 0 (needed *
info.Mirage_block.sector_size) in
+ B.write t n [ towrite ]
+--- a/lib/ring.ml
++++ b/lib/ring.ml
+@@ -34,7 +34,7 @@ let minimum_size_sectors = Int64.add sector_data 1L
+ let magic = Printf.sprintf "mirage shared-block-device 1.0"
+
+ let zero buf =
+- for i = 0 to Cstruct.len buf - 1 do
++ for i = 0 to Cstruct.length buf - 1 do
+ Cstruct.set_uint8 buf i 0
+ done
+
+@@ -357,7 +357,7 @@ module Producer = struct
+ let open ResultM in
+ let _sector = alloc t.info.Mirage_block.sector_size in
+ (* add a 4 byte header of size, and round up to the next 4-byte offset *)
+- let needed_bytes = Int64.(logand (lognot 3L) (add 7L (of_int (Cstruct.len
item)))) in
++ let needed_bytes = Int64.(logand (lognot 3L) (add 7L (of_int
(Cstruct.length item)))) in
+ let first_sector = Int64.(div t.producer.producer (of_int
t.info.Mirage_block.sector_size)) in
+ let first_offset = Int64.(to_int (rem t.producer.producer (of_int
t.info.Mirage_block.sector_size))) in
+
+@@ -365,23 +365,23 @@ module Producer = struct
+ the first page as it's only a 4-byte integer and we're padding to
4-byte offsets. *)
+ read_modify_write t first_sector (fun sector ->
+ (* Write the header and anything else we can *)
+- Cstruct.LE.set_uint32 sector first_offset (Int32.of_int (Cstruct.len
item));
++ Cstruct.LE.set_uint32 sector first_offset (Int32.of_int (Cstruct.length
item));
+ if first_offset + 4 = t.info.Mirage_block.sector_size
+ then item (* We can't write anything else, so just return the item *)
+ else begin
+- let this = min (t.info.Mirage_block.sector_size - first_offset - 4)
(Cstruct.len item) in
++ let this = min (t.info.Mirage_block.sector_size - first_offset - 4)
(Cstruct.length item) in
+ Cstruct.blit item 0 sector (first_offset + 4) this;
+ Cstruct.shift item this
+ end) >>= fun remaining ->
+
+ let rec loop offset remaining =
+- if Cstruct.len remaining = 0
++ if Cstruct.length remaining = 0
+ then return ()
+ else begin
+ read_modify_write t offset (fun sector ->
+- let this = min t.info.Mirage_block.sector_size (Cstruct.len
remaining) in
++ let this = min t.info.Mirage_block.sector_size (Cstruct.length
remaining) in
+ let frag = Cstruct.sub sector 0 this in
+- Cstruct.blit remaining 0 frag 0 (Cstruct.len frag);
++ Cstruct.blit remaining 0 frag 0 (Cstruct.length frag);
+ Cstruct.shift remaining this) >>= fun remaining ->
+ loop (Int64.succ offset) remaining
+ end in
+@@ -408,7 +408,7 @@ module Producer = struct
+ (fun () ->
+ let item = Item.to_cstruct item in
+ (* every item has a 4 byte header *)
+- let needed_bytes = Int64.(add 4L (of_int (Cstruct.len item))) in
++ let needed_bytes = Int64.(add 4L (of_int (Cstruct.length item))) in
+ let open C in
+ let open ResultM in
+ ok_to_write t needed_bytes
+@@ -535,10 +535,10 @@ module Consumer = struct
+ let frag = Cstruct.sub sector (4 + first_offset) this in
+ Cstruct.blit frag 0 result 0 this;
+ let rec loop consumer remaining =
+- if Cstruct.len remaining = 0
++ if Cstruct.length remaining = 0
+ then return ()
+ else
+- let this = min t.info.Mirage_block.sector_size (Cstruct.len
remaining) in
++ let this = min t.info.Mirage_block.sector_size (Cstruct.length
remaining) in
+ let frag = Cstruct.sub remaining 0 this in
+ read Int64.(add sector_data (rem consumer total_sectors)) t.disk
sector >>= fun () ->
+ Cstruct.blit sector 0 frag 0 this;
+@@ -547,7 +547,7 @@ module Consumer = struct
+ (* Read the payload before updating the consumer pointer *)
+ let needed_bytes = Int64.(logand (lognot 3L) (add 7L (of_int (len)))) in
+ match Item.of_cstruct result with
+- | None -> Lwt.return (Error (`Msg (Printf.sprintf "Failed to parse
queue item: (%d)[%s]" (Cstruct.len result) (String.escaped (Cstruct.to_string
result)))))
++ | None -> Lwt.return (Error (`Msg (Printf.sprintf "Failed to parse
queue item: (%d)[%s]" (Cstruct.length result) (String.escaped
(Cstruct.to_string result)))))
+ | Some result ->
+ return (Int64.(add t.consumer.consumer needed_bytes),result)
+ end
+--- a/lib_test/test.ml
++++ b/lib_test/test.ml
+@@ -47,7 +47,7 @@ let alloc sector_size =
+ sector
+
+ let fill_with_message buffer message =
+- for i = 0 to Cstruct.len buffer - 1 do
++ for i = 0 to Cstruct.length buffer - 1 do
+ Cstruct.set_char buffer i (message.[i mod (String.length message)])
+ done
+
+--- a/shared-block-ring.opam
++++ b/shared-block-ring.opam
+@@ -13,7 +13,7 @@ depends: [
+ "ocaml" {>= "4.06.0"}
+ "bisect_ppx" {dev & >= "2.5.0"}
+ "cmdliner"
+- "cstruct" {>= "3.0.0"}
++ "cstruct" {>= "6.0.0"}
+ "dune" {>= "2.7.0"}
+ "duration"
+ "io-page"
+
+From f0b61e87f809dce36fb93e31349d02d9a679253a Mon Sep 17 00:00:00 2001
+From: Hannes Mehnert <han...@mehnert.org>
+Date: Thu, 27 Jan 2022 16:26:39 +0100
+Subject: [PATCH 2/3] adapt to mirage-block 3.0.0 changes
+
+--- a/lib/ring.ml
++++ b/lib/ring.ml
+@@ -92,14 +92,12 @@ module Common(Log: S.LOG)(B: S.BLOCK) = struct
+ m >>= function
+ | Error `Is_read_only -> Lwt.return (Error `Is_read_only)
+ | Error `Disconnected -> Lwt.return (Error `Disconnected)
+- | Error `Unimplemented -> Lwt.return (Error `Unimplemented)
+ | Error x -> Lwt.return (Error x)
+ | Ok x -> f x
+ let to_msg m =
+ let open Lwt.Infix in
+ m >>= function
+ | Error `Disconnected -> Lwt.return (Error (`Msg "BLOCK device has
already disconnected"))
+- | Error `Unimplemented -> Lwt.return (Error (`Msg "BLOCK function is
unimplemented"))
+ | Error `Is_read_only -> Lwt.return (Error (`Msg "BLOCK device is
read-only"))
+ | Error _ -> Lwt.return (Error (`Msg "Unknown error from BLOCK device"))
+ | Ok x -> Lwt.return (Ok x)
+@@ -110,14 +108,12 @@ module Common(Log: S.LOG)(B: S.BLOCK) = struct
+ let open Lwt.Infix in
+ m >>= function
+ | Error `Disconnected -> Lwt.return (Error `Disconnected)
+- | Error `Unimplemented -> Lwt.return (Error `Unimplemented)
+ | Error x -> Lwt.return (Error x)
+ | Ok x -> f x
+ let to_msg m =
+ let open Lwt.Infix in
+ m >>= function
+ | Error `Disconnected -> Lwt.return (Error (`Msg "BLOCK device has
already disconnected"))
+- | Error `Unimplemented -> Lwt.return (Error (`Msg "BLOCK function is
unimplemented"))
+ | Error _ -> Lwt.return (Error (`Msg "Unknown error from BLOCK device"))
+ | Ok x -> Lwt.return (Ok x)
+ let return x = Lwt.return (Ok x)
+--- a/shared-block-ring.opam
++++ b/shared-block-ring.opam
+@@ -21,8 +21,8 @@ depends: [
+ "logs"
+ "lwt"
+ "lwt_log"
+- "mirage-block" {>= "2.0.1"}
+- "mirage-block-unix"
++ "mirage-block" {>= "3.0.0"}
++ "mirage-block-unix" {>= "2.13.0"}
+ "mirage-clock" {>= "3.0.0"}
+ "mirage-clock-unix" {with-test}
+ "mirage-time" {>= "2.0.1"}
+
+From 1c99469a8f6ce12455c1e5e27c54eb5fe5611251 Mon Sep 17 00:00:00 2001
+From: Hannes Mehnert <han...@mehnert.org>
+Date: Mon, 11 Apr 2022 11:18:01 +0200
+Subject: [PATCH 3/3] update to cmdliner 1.1.0, remove io-page-unix dependency
+
+--- a/example/dune
++++ b/example/dune
+@@ -6,7 +6,6 @@
+ cmdliner
+ cstruct
+ io-page
+- io-page-unix
+ logs
+ logs.fmt
+ logs.lwt
+--- a/example/main.ml
++++ b/example/main.ml
+@@ -171,8 +171,10 @@ let produce_cmd =
+ `S "DESCRIPTION";
+ `P "Read lines of text from stdin and push them as individual items onto
the ring.";
+ ] @ help in
+- Term.(ret(pure produce $ filename $ interval)),
+- Term.info "produce" ~doc ~man
++ let term = Term.(ret(const produce $ filename $ interval))
++ and info = Cmd.info "produce" ~doc ~man
++ in
++ Cmd.v info term
+
+ let consume_cmd =
+ let doc = "Pop data from the ring" in
+@@ -180,8 +182,10 @@ let consume_cmd =
+ `S "DESCRIPTION";
+ `P "Read lines of text from the ring and print them to stdout.";
+ ] @ help in
+- Term.(ret(pure consume $ filename $ interval)),
+- Term.info "consume" ~doc ~man
++ let term = Term.(ret(const consume $ filename $ interval))
++ and info = Cmd.info "consume" ~doc ~man
++ in
++ Cmd.v info term
+
+ let create_cmd =
+ let doc = "Create an empty ring" in
+@@ -189,8 +193,10 @@ let create_cmd =
+ `S "DESCRIPTION";
+ `P "Initialise a device or file with an empty ring."
+ ] @ help in
+- Term.(ret(pure create $ filename)),
+- Term.info "create" ~doc ~man
++ let term = Term.(ret(const create $ filename))
++ and info = Cmd.info "create" ~doc ~man
++ in
++ Cmd.v info term
+
+ let diagnostics_cmd =
+ let doc = "Display the current state of a ring." in
+@@ -199,8 +205,10 @@ let diagnostics_cmd =
+ `P "Display the current ring state including producer and consumer
pointers, together with the current ring contents for diagnostic purposes.";
+ `P "Note: the ring will not be modified."
+ ] @ help in
+- Term.(ret(pure diagnostics $ filename)),
+- Term.info "diagnostics" ~doc ~man
++ let term = Term.(ret(const diagnostics $ filename))
++ and info = Cmd.info "diagnostics" ~doc ~man
++ in
++ Cmd.v info term
+
+ let suspend_cmd =
+ let doc = "Suspend the ring." in
+@@ -208,8 +216,10 @@ let suspend_cmd =
+ `S "DESCRIPTION";
+ `P "Perform a co-operative suspend of the ring. Once finished, the
producer will have acknowledged and promise not to send any more data.";
+ ] @ help in
+- Term.(ret(pure suspend $ filename)),
+- Term.info "suspend" ~doc ~man
++ let term = Term.(ret(const suspend $ filename))
++ and info = Cmd.info "suspend" ~doc ~man
++ in
++ Cmd.v info term
+
+ let resume_cmd =
+ let doc = "Resume the ring." in
+@@ -217,19 +227,19 @@ let resume_cmd =
+ `S "DESCRIPTION";
+ `P "Perform a co-operative resume of the ring. Once finished, the
producer will have acknowledged and will be able to produce data.";
+ ] @ help in
+- Term.(ret(pure resume $ filename)),
+- Term.info "resume" ~doc ~man
++ let term = Term.(ret(const resume $ filename))
++ and info = Cmd.info "resume" ~doc ~man
++ in
++ Cmd.v info term
+
+-let default_cmd =
+- let doc = "manipulate shared rings on block devices" in
+- let man = help in
+- Term.(ret (pure (`Help (`Pager, None)))),
+- Term.info (Sys.argv.(0)) ~version:"1.0.0" ~doc ~man
++let default_cmd = Term.(ret (const (`Help (`Pager, None))))
+
+ let cmds = [create_cmd; produce_cmd; consume_cmd; suspend_cmd; resume_cmd;
diagnostics_cmd]
+
+-let _ =
++let () =
+ Logs.set_reporter (Logs_fmt.reporter ());
+- match Term.eval_choice default_cmd cmds with
+- | `Error _ -> exit 1
+- | _ -> exit 0
++ let doc = "manipulate shared rings on block devices" in
++ let man = help in
++ let info = Cmd.info (Sys.argv.(0)) ~version:"%%VERSION%%" ~doc ~man in
++ let group = Cmd.group ~default:default_cmd info cmds in
++ exit (Cmd.eval group)
+--- a/lib_test/dune
++++ b/lib_test/dune
+@@ -4,7 +4,6 @@
+ cstruct
+ duration
+ io-page
+- io-page-unix
+ logs
+ logs.fmt
+ logs.lwt
+--- a/shared-block-ring.opam
++++ b/shared-block-ring.opam
+@@ -12,12 +12,11 @@ bug-reports:
"https://github.com/mirage/shared-block-ring/issues/";
+ depends: [
+ "ocaml" {>= "4.06.0"}
+ "bisect_ppx" {dev & >= "2.5.0"}
+- "cmdliner"
++ "cmdliner" {>= "1.1.0"}
+ "cstruct" {>= "6.0.0"}
+ "dune" {>= "2.7.0"}
+ "duration"
+- "io-page"
+- "io-page-unix" {>= "2.0.0"}
++ "io-page" {>= "2.4.0"}
+ "logs"
+ "lwt"
+ "lwt_log"
diff --git a/dev-ml/shared-block-ring/metadata.xml
b/dev-ml/shared-block-ring/metadata.xml
new file mode 100644
index 000000000..393a3ec73
--- /dev/null
+++ b/dev-ml/shared-block-ring/metadata.xml
@@ -0,0 +1,11 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE pkgmetadata SYSTEM "http://www.gentoo.org/dtd/metadata.dtd";>
+<pkgmetadata>
+ <maintainer type="person">
+ <email>lssndrbarbi...@gmail.com</email>
+ <name>Alessandro Barbieri</name>
+ </maintainer>
+ <upstream>
+ <remote-id type="github">mirage/shared-block-ring</remote-id>
+ </upstream>
+</pkgmetadata>
diff --git a/dev-ml/shared-block-ring/shared-block-ring-3.0.0.ebuild
b/dev-ml/shared-block-ring/shared-block-ring-3.0.0.ebuild
new file mode 100644
index 000000000..ad7e707b0
--- /dev/null
+++ b/dev-ml/shared-block-ring/shared-block-ring-3.0.0.ebuild
@@ -0,0 +1,41 @@
+# Copyright 1999-2022 Gentoo Authors
+# Distributed under the terms of the GNU General Public License v2
+
+EAPI=8
+
+inherit dune
+
+DESCRIPTION="A simple on-disk fixed length queue"
+HOMEPAGE="https://github.com/mirage/shared-block-ring";
+SRC_URI="https://github.com/mirage/${PN}/archive/refs/tags/${PV}.tar.gz ->
${P}.tar.gz"
+
+LICENSE="ISC"
+SLOT="0/${PV}"
+KEYWORDS="~amd64"
+IUSE="ocamlopt test"
+
+RDEPEND="
+ >=dev-ml/cstruct-6.0.0:=[ppx]
+ dev-ml/lwt:=
+ dev-ml/lwt_log:=
+ dev-ml/cmdliner:=
+ dev-ml/duration:=
+ >=dev-ml/io-page-2.4.0:=
+ dev-ml/logs:=
+ >=dev-ml/mirage-block-2.0.1:=
+ dev-ml/mirage-block-unix:=
+ dev-ml/mirage-clock:=
+ >=dev-ml/mirage-time-2.0.1:=
+ >=dev-ml/ppx_sexp_conv-0.10.0:=
+ dev-ml/result:=
+ dev-ml/rresult:=
+ dev-ml/sexplib:=
+ dev-ml/sexplib0:=
+"
+DEPEND="
+ ${RDEPEND}
+ test? ( >=dev-ml/ounit-2 )
+"
+
+RESTRICT="!test? ( test )"
+PATCHES="${FILESDIR}/${P}-PR-62.patch"
