Skip to content

Commit

Permalink
Merge pull request #626 from tleedjarv/umarshal
Browse files Browse the repository at this point in the history 
Umarshal - version-independent serialization format
  • Loading branch information
@gdt
gdt committed Feb 17, 2022
2 parents fb043b3 + 9db75bf commit 36ed884
Show file tree
Hide file tree
Showing 60 changed files with 1,899 additions and 222 deletions.
119 changes: 105 additions & 14 deletions src/.depend
View file

Large diffs are not rendered by default.

1 change: 1 addition & 0 deletions src/Makefile.OCaml
View file
Expand Up @@ -214,6 +214,7 @@ endif
# File extensions will be substituted for the native code version

OCAMLOBJS += \
ubase/umarshal.cmo \
ubase/rx.cmo \
\
unicode_tables.cmo unicode.cmo bytearray.cmo \
Expand Down
2 changes: 2 additions & 0 deletions src/bytearray.ml
View file
Expand Up @@ -19,6 +19,8 @@ open Bigarray

type t = (char, int8_unsigned_elt, c_layout) Array1.t

let m = Umarshal.bytearray

let length = Bigarray.Array1.dim

let create l = Bigarray.Array1.create Bigarray.char Bigarray.c_layout l
Expand Down
2 changes: 2 additions & 0 deletions src/bytearray.mli
View file
Expand Up @@ -4,6 +4,8 @@
type t =
(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t

val m : t Umarshal.t

val create : int -> t

val length : t -> int
Expand Down
166 changes: 166 additions & 0 deletions src/common.ml
View file
Expand Up @@ -68,16 +68,89 @@ let sortRoots rootList = Safelist.sort compareRoots rootList

(* ---------------------------------------------------------------------- *)

(* IMPORTANT!
This is the 2.51-compatible version of type [Common.prevState]. It must
always remain exactly the same as the type [Common.prevState] in version
2.51.5. This means that if any of the types it is composed of changes then
for each changed type also a 2.51-compatible version must be created. *)
type prevState251 =
Previous of Fileinfo.typ * Props.t251 * Os.fullfingerprint * Osx.ressStamp
| New

type prevState =
Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp
| New

let mprevState = Umarshal.(sum2
(prod4 Fileinfo.mtyp Props.m Os.mfullfingerprint Osx.mressStamp id id)
unit
(function
| Previous (a, b, c, d) -> I21 (a, b, c, d)
| New -> I22 ())
(function
| I21 (a, b, c, d) -> Previous (a, b, c, d)
| I22 () -> New))

(* IMPORTANT!
This is the 2.51-compatible version of type [Common.contentschange]. It
must always remain exactly the same as the type [Common.contentschange]
in version 2.51.5. This means that if any of the types it is composed of
changes then for each changed type also a 2.51-compatible version must be
created. *)
type contentschange251 =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp251 * Osx.ressStamp

type contentschange =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp

let mcontentschange = Umarshal.(sum2 unit (prod3 Os.mfullfingerprint Fileinfo.mstamp Osx.mressStamp id id)
(function
| ContentsSame -> I21 ()
| ContentsUpdated (a, b, c) -> I22 (a, b, c))
(function
| I21 () -> ContentsSame
| I22 (a, b, c) -> ContentsUpdated (a, b, c)))

type permchange = PropsSame | PropsUpdated

let mpermchange = Umarshal.(sum2 unit unit
(function
| PropsSame -> I21 ()
| PropsUpdated -> I22 ())
(function
| I21 () -> PropsSame
| I22 () -> PropsUpdated))

(* IMPORTANT!
These are the 2.51-compatible versions of types [Common.updateItem] and
[Common.updateContent]. They must always remain exactly the same as the
types [Common.updateItem] and [Common.updateContent] in version 2.51.5.
This means that if any of the types they are composed of changes then
for each changed type also a 2.51-compatible version must be created. *)
type updateItem251 =
NoUpdates (* Path not changed *)
| Updates (* Path changed in this replica *)
of updateContent251 (* - new state *)
* prevState251 (* - summary of old state *)
| Error (* Error while detecting updates *)
of string (* - description of error *)

and updateContent251 =
Absent (* Path refers to nothing *)
| File (* Path refers to an ordinary file *)
of Props.t251 (* - summary of current state *)
* contentschange251 (* - hint to transport agent *)
| Dir (* Path refers to a directory *)
of Props.t251 (* - summary of current state *)
* (Name.t * updateItem251) list(* - children;
MUST KEEP SORTED for recon *)
* permchange (* - did permissions change? *)
* bool (* - is the directory now empty? *)
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)

type updateItem =
NoUpdates (* Path not changed *)
| Updates (* Path changed in this replica *)
Expand All @@ -100,6 +173,99 @@ and updateContent =
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)

let mupdateItem_rec mupdateContent =
Umarshal.(sum3 unit (prod2 mupdateContent mprevState id id) string
(function
| NoUpdates -> I31 ()
| Updates (a, b) -> I32 (a, b)
| Error a -> I33 a)
(function
| I31 () -> NoUpdates
| I32 (a, b) -> Updates (a, b)
| I33 a -> Error a))

let mupdateContent_rec mupdateItem =
Umarshal.(sum4
unit
(prod2 Props.m mcontentschange id id)
(prod4 Props.m (list (prod2 Name.m mupdateItem id id)) mpermchange bool id id)
string
(function
| Absent -> I41 ()
| File (a, b) -> I42 (a, b)
| Dir (a, b, c, d) -> I43 (a, b, c, d)
| Symlink a -> I44 a)
(function
| I41 () -> Absent
| I42 (a, b) -> File (a, b)
| I43 (a, b, c, d) -> Dir (a, b, c, d)
| I44 a -> Symlink a))

let mupdateContent, mupdateItem =
Umarshal.rec2 mupdateItem_rec mupdateContent_rec

(* Compatibility conversion functions *)

let prev_to_compat251 (prev : prevState) : prevState251 =
match prev with
| Previous (typ, props, fp, ress) ->
Previous (typ, Props.to_compat251 props, fp, ress)
| New -> New

let prev_of_compat251 (prev : prevState251) : prevState =
match prev with
| Previous (typ, props, fp, ress) ->
Previous (typ, Props.of_compat251 props, fp, ress)
| New -> New

let change_to_compat251 (c : contentschange) : contentschange251 =
match c with
| ContentsSame -> ContentsSame
| ContentsUpdated (fp, stamp, ress) ->
ContentsUpdated (fp, Fileinfo.stamp_to_compat251 stamp, ress)

let change_of_compat251 (c : contentschange251) : contentschange =
match c with
| ContentsSame -> ContentsSame
| ContentsUpdated (fp, stamp, ress) ->
ContentsUpdated (fp, Fileinfo.stamp_of_compat251 stamp, ress)

let rec ui_to_compat251 (ui : updateItem) : updateItem251 =
match ui with
| NoUpdates -> NoUpdates
| Updates (uc, prev) -> Updates (uc_to_compat251 uc, prev_to_compat251 prev)
| Error s -> Error s

and ui_of_compat251 (ui : updateItem251) : updateItem =
match ui with
| NoUpdates -> NoUpdates
| Updates (uc, prev) -> Updates (uc_of_compat251 uc, prev_of_compat251 prev)
| Error s -> Error s

and children_to_compat251 l =
Safelist.map (fun (n, ui) -> (n, ui_to_compat251 ui)) l

and children_of_compat251 l =
Safelist.map (fun (n, ui) -> (n, ui_of_compat251 ui)) l

and uc_to_compat251 (uc : updateContent) : updateContent251 =
match uc with
| Absent -> Absent
| File (props, change) ->
File (Props.to_compat251 props, change_to_compat251 change)
| Dir (props, ch, perm, empty) ->
Dir (Props.to_compat251 props, children_to_compat251 ch, perm, empty)
| Symlink s -> Symlink s

and uc_of_compat251 (uc : updateContent251) : updateContent =
match uc with
| Absent -> Absent
| File (props, change) ->
File (Props.of_compat251 props, change_of_compat251 change)
| Dir (props, ch, perm, empty) ->
Dir (Props.of_compat251 props, children_of_compat251 ch, perm, empty)
| Symlink s -> Symlink s

(* ------------------------------------------------------------------------- *)

type status =
Expand Down
41 changes: 40 additions & 1 deletion src/common.mli
View file
Expand Up @@ -41,14 +41,46 @@ type 'a oneperpath = ONEPERPATH of 'a list
filesystem below a given path and the state recorded in the archive below
that path. The other types are helpers. *)

type prevState251 =
Previous of Fileinfo.typ * Props.t251 * Os.fullfingerprint * Osx.ressStamp
| New

type contentschange251 =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp251 * Osx.ressStamp
type permchange = PropsSame | PropsUpdated

(* Variable name prefix: "ui" *)
type updateItem251 =
NoUpdates (* Path not changed *)
| Updates (* Path changed in this replica *)
of updateContent251 (* - new state *)
* prevState251 (* - summary of old state *)
| Error (* Error while detecting updates *)
of string (* - description of error *)

(* Variable name prefix: "uc" *)
and updateContent251 =
Absent (* Path refers to nothing *)
| File (* Path refers to an ordinary file *)
of Props.t251 (* - summary of current state *)
* contentschange251 (* - hint to transport agent *)
| Dir (* Path refers to a directory *)
of Props.t251 (* - summary of current state *)
* (Name.t * updateItem251) list(* - children
MUST KEEP SORTED for recon *)
* permchange (* - did permissions change? *)
* bool (* - is the directory now empty? *)
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)

type prevState =
Previous of Fileinfo.typ * Props.t * Os.fullfingerprint * Osx.ressStamp
| New

type contentschange =
ContentsSame
| ContentsUpdated of Os.fullfingerprint * Fileinfo.stamp * Osx.ressStamp
type permchange = PropsSame | PropsUpdated

(* Variable name prefix: "ui" *)
type updateItem =
Expand All @@ -74,6 +106,13 @@ and updateContent =
| Symlink (* Path refers to a symbolic link *)
of string (* - link text *)

val mupdateItem : updateItem Umarshal.t
val mupdateContent : updateContent Umarshal.t

val ui_to_compat251 : updateItem -> updateItem251
val ui_of_compat251 : updateItem251 -> updateItem
val uc_to_compat251 : updateContent -> updateContent251
val uc_of_compat251 : updateContent251 -> updateContent

(*****************************************************************************)
(* COMMON TYPES SHARED BY RECONCILER AND TRANSPORT AGENT *)
Expand Down

0 comments on commit 36ed884

Please sign in to comment.