From f1a3588911cb44ac8f85d030a0f7719dd6bdf6beb7ec13c6ef70c20cb14df1ad Mon Sep 17 00:00:00 2001 From: Sergey Matveev Date: Mon, 7 Apr 2025 14:42:43 +0300 Subject: [PATCH] Advanced schemas specification --- c/cmd/clean | 2 +- c/doc/cmd.texi | 9 +- c/lib/cm/default.schema.keks.do | 8 +- c/lib/cm/pub.c | 21 ++--- c/lib/schema.c | 46 ++++++++-- go/cm/default.schema.keks.do | 8 +- go/cm/utils/mk-bin | 1 + go/schema/check.go | 50 ++++++++--- spec/cm/encrypted.cddl | 51 ----------- spec/cm/encrypted.texi | 2 +- spec/cm/hashed.cddl | 8 -- spec/cm/hashed.texi | 2 +- spec/cm/index.texi | 3 +- spec/cm/prv.cddl | 4 - spec/cm/prv.texi | 2 +- spec/cm/pub-load.cddl | 15 ---- spec/cm/pub-sig-tbs.cddl | 8 -- spec/cm/pub.texi | 8 +- spec/cm/signed-prehash.cddl | 4 - spec/cm/signed.cddl | 29 ------ spec/cm/signed.texi | 6 +- spec/schema/cmds.texi | 66 +++++++------- spec/schema/tcl.texi | 94 +++++++++----------- tcl/schema-marshal | 150 ++++++++++++++++++++++++++++++++ tcl/schema2bin | 143 ------------------------------ tcl/schemas/av.tcl | 5 ++ tcl/schemas/encrypted.tcl | 75 +++++++--------- tcl/schemas/fpr.tcl | 1 + tcl/schemas/hashed.tcl | 8 ++ tcl/schemas/pub-load.tcl | 8 ++ tcl/schemas/pub-sig-tbs.tcl | 11 +++ tcl/schemas/pub.tcl | 91 ++++--------------- tcl/schemas/signed-prehash.tcl | 5 ++ tcl/schemas/signed.tcl | 61 ++++--------- 34 files changed, 442 insertions(+), 563 deletions(-) delete mode 100644 spec/cm/encrypted.cddl delete mode 100644 spec/cm/hashed.cddl delete mode 100644 spec/cm/prv.cddl delete mode 100644 spec/cm/pub-load.cddl delete mode 100644 spec/cm/pub-sig-tbs.cddl delete mode 100644 spec/cm/signed-prehash.cddl delete mode 100644 spec/cm/signed.cddl create mode 100755 tcl/schema-marshal delete mode 100755 tcl/schema2bin create mode 100644 tcl/schemas/av.tcl create mode 100644 tcl/schemas/fpr.tcl create mode 100644 tcl/schemas/hashed.tcl create mode 100644 tcl/schemas/pub-load.tcl create mode 100644 tcl/schemas/pub-sig-tbs.tcl create mode 100644 tcl/schemas/signed-prehash.tcl diff --git a/c/cmd/clean b/c/cmd/clean index 7e3f4e0..b725ddc 100755 --- a/c/cmd/clean +++ b/c/cmd/clean @@ -1,10 +1,10 @@ #!/bin/sh -e cd "$(dirname "$(realpath -- "$0")")" -cer-verify/clean deatomiser/clean for-fuzz/clean lib/clean pp/clean +pub-verify/clean schema-validate/clean test-vector/clean diff --git a/c/doc/cmd.texi b/c/doc/cmd.texi index e1bc250..4f8bcda 100644 --- a/c/doc/cmd.texi +++ b/c/doc/cmd.texi @@ -20,10 +20,15 @@ and pretty prints it. It respects @env{$NO_COLOR} environment variable. If @env{$DO_ENCODE} is specified, then it encodes the decoded items into memory again and compares if it has the same representation. -@pindex cmd/cer-verify -@item cmd/cer-verify +@pindex cmd/pub-verify +@item cmd/pub-verify Example program that accepts a list of certificate files. First one is that ought to be verified. Currently it installs GOST R 3410-2012 and Ed25519-BLAKE2b cryptographic handlers for signature verification. +@pindex cmd/schema-validate +@item cmd/schema-validate +Example program that accepts KEKS-encoded schemas, KEKS-encoded data and +schema name to verify against. + @end table diff --git a/c/lib/cm/default.schema.keks.do b/c/lib/cm/default.schema.keks.do index 4d4033b..b361b40 100644 --- a/c/lib/cm/default.schema.keks.do +++ b/c/lib/cm/default.schema.keks.do @@ -1,3 +1,7 @@ n=${2##*/}.tcl -redo-ifchange ../../../tcl/schema2bin ../../../tcl/schemas/$n -../../../tcl/schema2bin ../../../tcl/schemas/$n | xxd -r -p +cd ../../../tcl/schemas +{ + echo ../schema-marshal $n + sed -n "s/^schema-include \(.*\)$/\1/p" <$n +} | xargs redo-ifchange +../schema-marshal $n | xxd -r -p diff --git a/c/lib/cm/pub.c b/c/lib/cm/pub.c index f059f9f..04d8fb1 100644 --- a/c/lib/cm/pub.c +++ b/c/lib/cm/pub.c @@ -1,3 +1,4 @@ +#include #include #include #include @@ -82,28 +83,16 @@ KEKSCMPubParse( &(cer->since), items->list[idx + 1].atom.v.str.ptr, items->list[idx + 1].atom.v.str.len); - if ((err != KEKSErrNo) || (cer->since.tv_nsec != 0)) { - (*failReason) = "bad /sigs/./tbs/exp/since value"; - return KEKSErrUnsatisfiedSchema; - } + assert(err == KEKSErrNo); err = KEKSTimespecToUTC(&(cer->since)); - if (err != KEKSErrNo) { - (*failReason) = "bad /sigs/./tbs/exp/since UTC value"; - return KEKSErrUnsatisfiedSchema; - } + assert(err == KEKSErrNo); err = KEKSTAI64ToTimespec( &(cer->till), items->list[idx + 2].atom.v.str.ptr, items->list[idx + 2].atom.v.str.len); - if ((err != KEKSErrNo) || (cer->till.tv_nsec != 0)) { - (*failReason) = "bad /sigs/./tbs/exp/till value"; - return KEKSErrUnsatisfiedSchema; - } + assert(err == KEKSErrNo); err = KEKSTimespecToUTC(&(cer->till)); - if (err != KEKSErrNo) { - (*failReason) = "bad /sigs/./tbs/exp/till UTC value"; - return KEKSErrUnsatisfiedSchema; - } + assert(err == KEKSErrNo); return KEKSErrNo; } diff --git a/c/lib/schema.c b/c/lib/schema.c index 355aac4..08cad23 100644 --- a/c/lib/schema.c +++ b/c/lib/schema.c @@ -17,8 +17,11 @@ #include #include #include +#include #include "atom.h" +#include "dectai.h" +#include "err.h" #include "frombe.h" #include "items.h" #include "schema.h" @@ -31,8 +34,9 @@ static const char CmdLT[] = "<"; static const char CmdNotExists[] = "!E"; static const char CmdSchema[] = "S"; static const char CmdTake[] = "."; -static const char CmdTimeMaxPrec[] = "TMP"; +static const char CmdTimePrec[] = "TP"; static const char CmdType[] = "T"; +static const char CmdUTC[] = "UTC"; static const char TypeBin[] = "BIN"; static const char TypeBlob[] = "BLOB"; @@ -44,7 +48,7 @@ static const char TypeMagic[] = "MAGIC"; static const char TypeMap[] = "MAP"; static const char TypeNIL[] = "NIL"; static const char TypeStr[] = "STR"; -static const char TypeTAI64[] = "TAI64"; +static const char TypeTAI[] = "TAI"; static struct KEKSSchemaErr keksSchemaCmd( @@ -359,7 +363,7 @@ Eached: } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), TypeBlob)) { expected[idxExpected] = KEKSItemBlob; idxExpected++; - } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), TypeTAI64)) { + } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), TypeTAI)) { expected[idxExpected] = KEKSItemTAI64; idxExpected++; } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), TypeMagic)) { @@ -470,7 +474,7 @@ Eached: } err.code = KEKSSchemaErrNo; } - } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), CmdTimeMaxPrec)) { + } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), CmdTimePrec)) { idxSchema = schema->list[idxSchema].next; if (idxSchema == 0) { err.code = KEKSSchemaErrInvalidSchema; @@ -480,10 +484,10 @@ Eached: err.offSchema = schema->offsets[idxSchema]; if (schema->list[idxSchema].atom.typ != KEKSItemPint) { err.code = KEKSSchemaErrInvalidSchema; - err.msg = "non-int TIMEMAXPREC"; + err.msg = "non-int TIMEPREC"; return err; } - err.msg = "TIMEMAXPREC"; + err.msg = "TIMEPREC"; if ((*taken) == SIZE_MAX) { err.code = KEKSSchemaErrNo; } else { @@ -554,7 +558,35 @@ Eached: break; default: err.code = KEKSSchemaErrInvalidSchema; - err.msg = "unknown TIMEMAXPREC value"; + err.msg = "unknown TIMEPREC value"; + return err; + } + err.code = KEKSSchemaErrNo; + } + } else if (KEKSStrEqual(&(schema->list[idxSchema].atom), CmdUTC)) { + err.msg = "UTC"; + if ((*taken) == SIZE_MAX) { + err.code = KEKSSchemaErrNo; + } else { + if (data->list[*taken].atom.typ != KEKSItemTAI64) { + err.code = KEKSSchemaErrUnexpectedState; + err.msg = "non-TAI64 taken"; + return err; + } + struct timespec tv; + enum KEKSErr errConvert = KEKSTAI64ToTimespec( + &tv, + data->list[*taken].atom.v.str.ptr, + data->list[*taken].atom.v.str.len); + if (errConvert != KEKSErrNo) { + err.code = KEKSSchemaErrInvalidData; + err.msg = "can not convert to timespec"; + return err; + } + errConvert = KEKSTimespecToUTC(&tv); + if (errConvert != KEKSErrNo) { + err.code = KEKSSchemaErrInvalidData; + err.msg = "can not convert to UTC"; return err; } err.code = KEKSSchemaErrNo; diff --git a/go/cm/default.schema.keks.do b/go/cm/default.schema.keks.do index 220156c..cd2826b 100644 --- a/go/cm/default.schema.keks.do +++ b/go/cm/default.schema.keks.do @@ -1,3 +1,7 @@ n=${2##*/}.tcl -redo-ifchange ../../tcl/schema2bin ../../tcl/schemas/$n -../../tcl/schema2bin ../../tcl/schemas/$n | xxd -r -p +cd ../../tcl/schemas +{ + echo ../schema-marshal $n + sed -n "s/^schema-include \(.*\)$/\1/p" <$n +} | xargs redo-ifchange +../schema-marshal $n | xxd -r -p diff --git a/go/cm/utils/mk-bin b/go/cm/utils/mk-bin index b831406..58dcf0f 100755 --- a/go/cm/utils/mk-bin +++ b/go/cm/utils/mk-bin @@ -3,6 +3,7 @@ GO_LDFLAGS="${GO_LDFLAGS:--s}" root="$(dirname "$(realpath -- "$0")")" cd "$root/.." +redo-ifchange sign/signed.schema.keks sign/pub.schema.keks enc/encrypted.schema.keks mkdir -p bin for cmd in enc hsh key sig ; do cmd=${cmd}tool diff --git a/go/schema/check.go b/go/schema/check.go index ffc8aa8..3e12dd5 100644 --- a/go/schema/check.go +++ b/go/schema/check.go @@ -30,16 +30,17 @@ import ( ) const ( - CmdEach = "*" - CmdEq = "=" - CmdExists = "E" - CmdGT = ">" - CmdLT = "<" - CmdNotExists = "!E" - CmdSchema = "S" - CmdTake = "." - CmdTimeMaxPrec = "TMP" - CmdType = "T" + CmdEach = "*" + CmdEq = "=" + CmdExists = "E" + CmdGT = ">" + CmdLT = "<" + CmdNotExists = "!E" + CmdSchema = "S" + CmdTake = "." + CmdTimePrec = "TP" + CmdType = "T" + CmdUTC = "UTC" Magic = "schema" ) @@ -176,7 +177,7 @@ func Check(schemaName string, schemas map[string][][]any, data any) error { expected = append(expected, types.Map) case "BLOB": expected = append(expected, types.Blob) - case "TAI64": + case "TAI": expected = append(expected, types.TAI64, types.TAI64N, types.TAI64NA) case "MAGIC": expected = append(expected, types.Magic) @@ -293,7 +294,7 @@ func Check(schemaName string, schemas map[string][][]any, data any) error { return fmt.Errorf("%s: %d: %d: %s: %w", schemaName, i, n, cmd, err) } } - case CmdTimeMaxPrec: + case CmdTimePrec: if vs == nil { continue } @@ -391,6 +392,31 @@ func Check(schemaName string, schemas map[string][][]any, data any) error { schemaName, i, cmd, prec) } } + case CmdUTC: + if vs == nil { + continue + } + for _, v := range vs { + var isLeap bool + switch v := v.(type) { + case *tai64n.TAI64: + _, isLeap = tai64n.Leapsecs.Sub(v.Time()) + case *tai64n.TAI64N: + _, isLeap = tai64n.Leapsecs.Sub(v.Time()) + case *tai64n.TAI64NA: + var t tai64n.TAI64 + copy(t[:], v[:]) + _, isLeap = tai64n.Leapsecs.Sub(t.Time()) + case time.Time: + continue + default: + return fmt.Errorf("%s: %d: %s: unsupported data type: %T", + schemaName, i, cmd, v) + } + if isLeap { + return fmt.Errorf("%s: %d: %s: is leap", schemaName, i, cmd) + } + } default: return fmt.Errorf("%s: %d: %s: unknown command", schemaName, i, cmd) } diff --git a/spec/cm/encrypted.cddl b/spec/cm/encrypted.cddl deleted file mode 100644 index 34e5897..0000000 --- a/spec/cm/encrypted.cddl +++ /dev/null @@ -1,51 +0,0 @@ -cm-encrypted = { - ? id: uuid, - dem: dem, - kem: [+ kem], - ? payload: bytes, -} - -dem = dem-chapoly-krkc / dem-kuznechik-ctr-hmac-kr - -dem-chapoly-krkc = {a: "chapoly-krkc"} -dem-kuznechik-ctr-hmac-kr = {a: "kuznechik-ctr-hmac-kr"} - -kem = kem-balloon-blake2b-hkdf / - kem-gost3410-hkdf / - kem-sntrup4591761-x25519-hkdf-blake2b / - kem-mceliece6960119-x25519-hkdf-shake256 - -kem-balloon-blake2b-hkdf = { - a: "balloon-blake2b-hkdf", - cek: bytes, - cost: { - s: int, ; space cost - t: int, ; time cost - p: int, ; parallel cost - }, - salt: bytes, -} - -fpr = bytes .size 32 - -kem-gost3410-hkdf-kexp15 = { - a: "gost3410-hkdf-kexp15", - cek: bytes, - ukm: bytes, - pub: bytes, - ? to: fpr, ; recipient's public key fingerprint -} - -kem-sntrup4591761-x25519-hkdf-blake2b = { - a: "sntrup4591761-x25519-hkdf-blake2b", - cek: bytes, - encap: bytes, - ? to: fpr, ; recipient's public key fingerprint -} - -kem-mceliece6960119-x25519-hkdf-shake256 = { - a: "mceliece6960119-x25519-hkdf-shake256", - cek: bytes, - encap: bytes, - ? to: fpr, ; recipient's public key fingerprint -} diff --git a/spec/cm/encrypted.texi b/spec/cm/encrypted.texi index 3744d6b..e0d5dc2 100644 --- a/spec/cm/encrypted.texi +++ b/spec/cm/encrypted.texi @@ -25,7 +25,7 @@ if you use it. Stored in a file, it should begin with "cm/encrypted" @ref{MAGIC, magic}. -@verbatiminclude cm/encrypted.cddl +@verbatiminclude ../tcl/schemas/encrypted.tcl @code{/payload} contains the ciphertext. It is encrypted with random "content encryption key" (CEK) with an algorithm specified in diff --git a/spec/cm/hashed.cddl b/spec/cm/hashed.cddl deleted file mode 100644 index eb906ca..0000000 --- a/spec/cm/hashed.cddl +++ /dev/null @@ -1,8 +0,0 @@ -ai = text .ge 0 ; algorithm identifier - -cm-hashed = { - a: [+ ai], - t: text .gt 0, ; type of the content - ? v: bytes / blob, ; content itself - hash: [+ bytes], ; hash values -} diff --git a/spec/cm/hashed.texi b/spec/cm/hashed.texi index 499fbd3..276fad4 100644 --- a/spec/cm/hashed.texi +++ b/spec/cm/hashed.texi @@ -8,7 +8,7 @@ Integrity protected container, analogue to ASN.1-based Stored in a file, it should begin with "cm/hashed" @ref{MAGIC, magic}. -@verbatiminclude cm/hashed.cddl +@verbatiminclude ../tcl/schemas/hashed.tcl @code{/a} tells what algorithms will be used to hash the data. diff --git a/spec/cm/index.texi b/spec/cm/index.texi index c86999a..12fa73e 100644 --- a/spec/cm/index.texi +++ b/spec/cm/index.texi @@ -5,8 +5,7 @@ @unnumbered Cryptographic messages Here are some suggested formats for use with cryptographic messages. -They are written in -@url{https://datatracker.ietf.org/doc/html/rfc8610, CDDL}-like format. +They are written in @ref{TclSchemas, Tcl schemas} format. @include cm/prv.texi @include cm/signed.texi diff --git a/spec/cm/prv.cddl b/spec/cm/prv.cddl deleted file mode 100644 index b0b1e68..0000000 --- a/spec/cm/prv.cddl +++ /dev/null @@ -1,4 +0,0 @@ -ai = text .ge 0 ; algorithm identifier -av = {a: ai, v: bytes} - -cm-prv = av diff --git a/spec/cm/prv.texi b/spec/cm/prv.texi index e3f6cc8..876977f 100644 --- a/spec/cm/prv.texi +++ b/spec/cm/prv.texi @@ -5,7 +5,7 @@ Private key container. -@verbatiminclude cm/prv.cddl +@verbatiminclude ../tcl/schemas/av.tcl Stored in a file, it should begin with "cm/prv" @ref{MAGIC, magic}. diff --git a/spec/cm/pub-load.cddl b/spec/cm/pub-load.cddl deleted file mode 100644 index d3d98e2..0000000 --- a/spec/cm/pub-load.cddl +++ /dev/null @@ -1,15 +0,0 @@ -ai = text .ge 0 ; algorithm identifier -av = {a: ai, v: bytes} -fpr = bytes .size 32 -ku = "sig" / "kem" / "app-name" / text - -cm-pub-load = { - ? ku: set, - id: fpr, - pub: [+ av], - sub: {text => text}, ; subject - ? crit: {+ crit-ext-type => any}, - * text => any -} - -crit-ext-type = text diff --git a/spec/cm/pub-sig-tbs.cddl b/spec/cm/pub-sig-tbs.cddl deleted file mode 100644 index 31cfef0..0000000 --- a/spec/cm/pub-sig-tbs.cddl +++ /dev/null @@ -1,8 +0,0 @@ -validity = [since: tai64, till: tai64] - -cm-pub-sig-tbs = { - cid: uuid, ; certification id - exp: validity, - sid: fpr, ; signer's public key fingerprint - * text => any -} diff --git a/spec/cm/pub.texi b/spec/cm/pub.texi index 5de604d..9a1ab94 100644 --- a/spec/cm/pub.texi +++ b/spec/cm/pub.texi @@ -10,11 +10,7 @@ Stored in a file, it should begin with "cm/pub" @ref{MAGIC, magic}. Its @code{/load/t} equals to @code{pub}. @code{/load/v} contains @code{cm-pub-load}: -@verbatim -cm-pub = cm-signed ; with /load/t = "pub", /load/v = cm-pub-load -@end verbatim - -@verbatiminclude cm/pub-load.cddl +@verbatiminclude ../tcl/schemas/pub-load.tcl @table @code @@ -58,7 +54,7 @@ It @strong{must} be absent if empty. Values are extension specific. @code{cm-signed}'s @code{sig-tbs} @strong{must} contain additional fields: -@verbatiminclude cm/pub-sig-tbs.cddl +@verbatiminclude ../tcl/schemas/pub-sig-tbs.tcl @table @code diff --git a/spec/cm/signed-prehash.cddl b/spec/cm/signed-prehash.cddl deleted file mode 100644 index 4f94c22..0000000 --- a/spec/cm/signed-prehash.cddl +++ /dev/null @@ -1,4 +0,0 @@ -cm-signed-prehash = { - t: "prehash", - sigs: set, ; set of signature algorithm identifiers (/sigs/*/sign/a) -} diff --git a/spec/cm/signed.cddl b/spec/cm/signed.cddl deleted file mode 100644 index dc6a358..0000000 --- a/spec/cm/signed.cddl +++ /dev/null @@ -1,29 +0,0 @@ -ai = text .ge 0 ; algorithm identifier - -cm-signed = { - load: { - t: text .ge 0, - ? v: bytes / text / map / list, - }, - ? sigs: [+ sig], - ? pubs: [+ cm-pub], -} - -url = text .ge 0 - -sig = { - tbs: sig-tbs, - sign: {a: ai, v: bytes}, - ? pub-loc: [+ url], - * text => any -} - -fpr = bytes .size 32 - -sig-tbs = { - sid: fpr, ; signer's public key fingerprint - ? when: tai64 / tai64n, - ? nonce: bytes .gt 0, ; some optional random bytes - ? encrypted-to: [+ fpr], ; recipient's public key fingerprints - * text => any -} diff --git a/spec/cm/signed.texi b/spec/cm/signed.texi index 7973157..c5da863 100644 --- a/spec/cm/signed.texi +++ b/spec/cm/signed.texi @@ -20,7 +20,9 @@ Signed container, some kind of analogue to ASN.1-based Stored in a file, it should begin with "cm/signed" @ref{MAGIC, magic}, unless it is a @ref{cm-pub, public key}. -@verbatiminclude cm/signed.cddl +@verbatiminclude ../tcl/schemas/av.tcl +@verbatiminclude ../tcl/schemas/fpr.tcl +@verbatiminclude ../tcl/schemas/signed.tcl Signature is created by signing the: @@ -38,7 +40,7 @@ following approach: cm-signed-prehash || BLOB(detached-data) || cm-signed @end verbatim -@verbatiminclude cm/signed-prehash.cddl +@verbatiminclude ../tcl/schemas/signed-prehash.tcl With @code{cm-signed-prehash} you initialise your hashers used during signing process and feed BLOB's contents (not the encoded BLOB itself!) diff --git a/spec/schema/cmds.texi b/spec/schema/cmds.texi index 6804d67..6013bab 100644 --- a/spec/schema/cmds.texi +++ b/spec/schema/cmds.texi @@ -12,43 +12,44 @@ following elements are command-specific. Here is full list of structure validation commands, that should be generated from higher level schema descriptions. -@table @code +@multitable @columnfractions .20 .10 .20 .50 +@headitem name @tab encoded @tab args @tab description -@item . k -Take/choose the value of the "k" key in the map, if "k" is a string. -If "k" is integer, then choose the k-th value in a list. -If "k" equals to ".", then choose the element you are currently in -(current map or list). Command never fails, but key can be non-existent. +@item TAKE @tab @code{.} @tab k @tab +Take/choose the value of the @code{k} key in the map, if @code{k} is a +string. If @code{k} is integer, then choose the k-th value in a list. If +@code{k} equals to @code{.}, then choose the element you are currently +in. Command never fails, but key can be non-existent. -@item E -Check that chosen element exists. +@item EXISTS @tab @code{E} @tab @tab +Assure that chosen element exists. -@item !E -Check that chosen element does not exist. +@item !EXISTS @tab @code{!E} @tab @tab +Assure that chosen element does not exist. -@item * +@item EACH @tab @code{*} @tab @tab Execute the next command against every element of the chosen (if it exists) list, or every value of the map. -@item T T0 [T1 ...] -Check that chosen (if it exists) element's type is in (T0[, T1 ...]) set. -Possible types: BIN, BLOB, BOOL, HEXLET, INT, LIST, MAGIC, MAP, NIL, -STR, TAI64. +@item TYPE @tab @code{T} @tab T0 [T1 ...] @tab +Check that chosen (if it exists) element's type is in (T0, T1 ...) set. +Possible types: BIN, BLOB, BOOL, HEXLET, INT, LIST, MAGIC, MAP, NIL, STR, TAI. -@item > n -Check that chosen (if it exists) integer value is greater than "n". +@item GT @tab @code{>} @tab n @tab +Check that chosen (if it exists) integer value is greater than @code{n}. If chosen value is either list or map, then check their length. If the value is a string, then check its length. -@item < n -Same as @code{>}, but check that value is less than "n". +@item LT @tab @code{<} @tab n @tab +Same as @code{>}, but check that value is less than @code{n}. -@item S s -Check chosen (if it exists) element against schema named "s". +@item SCHEMA @tab @code{S} @tab s @tab +Check chosen (if it exists) element against schema named @code{s}. -@item TMP p -Check that chosen (if it exists) element, of time type, has value below -maximal time precision. "p" is integer with following possible values: +@item TIMEPREC @tab @code{TP} @tab p @tab +Check that chosen (if it exists) element, of time type, has value of +maximal specified time precision. @code{p} is integer with following +possible values: @itemize @item 0 -- only full seconds allowed, no parts; @item 3 -- only up to milliseconds; @@ -59,10 +60,15 @@ maximal time precision. "p" is integer with following possible values: @item 18 -- up to attoseconds; @end itemize -@item = v -Check that chosen (if it exists) element's value equals to binary string "v". +@item UTC @tab @code{UTC} @tab @tab +Check that chosen (if it exists) element, of time type, can be converted +to UTC. -@end table +@item EQ @tab @code{=} @tab v @tab +Check that chosen (if it exists) element's value equals to binary string +@code{v}. + +@end multitable For example let's check "our" structure, described in CDDL as: @@ -72,9 +78,9 @@ fpr = bytes .size 32 our = {a: ai, v: bytes/text, fpr: fpr, ?comment: text} @end verbatim -"a", "v", "fpr" fields are required ones. "v" has two allowable types. -"comment" is optional, but typed. And "fpr" has fixed length. -Corresponding schema can be: +@code{a}, @code{v}, @code{fpr} fields are required ones. @code{v} has +two allowable types. @code{comment} is optional, but typed. And +@code{fpr} has fixed length. Corresponding schema can be: @verbatim {"our": [ diff --git a/spec/schema/tcl.texi b/spec/schema/tcl.texi index 05d5862..a00363c 100644 --- a/spec/schema/tcl.texi +++ b/spec/schema/tcl.texi @@ -5,66 +5,58 @@ Validation commands are pretty low-level and are inconvenient to write by hand, at least because of huge quantity of TAKEs. -@command{tcl/schema2bin} utility gives ability to convert much more +@command{tcl/schema-marshal} utility gives ability to convert much more nicer schemas written on Tcl language to the KEKS-encoded commands. Example with "our" structure can be written as: @verbatim -SCHEMAS { +ai {{field . {str} >0}} +fpr {{field . {bin} len=32}} our { - {HAS a} - {TYPE= a {STR}} - {!EMPTY a} - - {HAS v} - {TYPE= v {BIN STR}} - - {HAS fpr} - {TYPE= fpr {BIN}} - {LEN= fpr 32} - - {TYPE= comment {STR}} -} + {field a {with ai}} + {field v {bin str}} + {field fpr {with fpr}} + {field comment {str} optional} } @end verbatim and @ref{cm-pub, cm/pub} as: @verbatiminclude ../tcl/schemas/pub.tcl - -@command{schema2bin} provides additional shorter aliased commands: - -@table @code - -@item HAS k -Check existence of "k" element. - -@item !HAS k -Opposite to HAS. - -@item LEN= k l -Check that "k" has value equal to "l". - -@item TYPE= k Ts -Check that "k" has type in "Ts" set. - -@item TYPE* k Ts -Check that each element of "k" has type in "Ts" set. - -@item SCHEMA= k s -Check "k" against "s" schema. - -@item SCHEMA* k s -Check each element of "k" against "s" schema. - -@item !EMPTY k -Check that "k" element's length is greater than zero. - -@item IS-SET k -Check that "k" is non-empty set (map with NIL values). - -@item STR= k v -Check that "k" is a string with value "v". - -@end table +@verbatiminclude ../tcl/schemas/fpr.tcl +@verbatiminclude ../tcl/schemas/pub-load.tcl +@verbatiminclude ../tcl/schemas/pub-sig-tbs.tcl + +@command{schema-marshal} calls @code{schemas@{s0 cmds0 s1 cmds1 ...@}} +commands to produce an encoded map with @code{cmds*} commands for +@code{s*} schemas. There is @code{field} command that helps creation of +commands related to the field. + +Its first argument is either field's name in the map, or list's index or +dot, meaning the self-structure itself. + +Second argument is a list of allowable types, written in lowercase. If +that list consists of @code{with S}, then SCHEMA command will be called +instead of TYPE checking. If list consists of @code{set}, then it is +checked to be a MAP with EACH value of NIL. + +All other arguments are optional. + +By default, if no @code{optional} argument is specified, then explicit +EXISTS check is called for the field. If @code{!exists} argument is +specified, then it is explicitly checked to be non-existent and you can +specify empty list of types in second argument. + +@code{>n} and @code{0} assures that either list/map or strings are not +empty. @code{len=n} checks the exact length. @code{=v} checks that given +element has specified value. + +@code{prec=p} issues TIMEPREC command, but instead of specifying the raw +integer values, you choose one of: s, ms, us, ns, ps, fs, as. @code{utc} +issues UTC command. + +@code{of s} argument issues checking of EACH element of the list or map +against the specified schema, or against specified type if @code{s} is a +known type. diff --git a/tcl/schema-marshal b/tcl/schema-marshal new file mode 100755 index 0000000..e26a130 --- /dev/null +++ b/tcl/schema-marshal @@ -0,0 +1,150 @@ +#!/usr/bin/env tclsh +# schema-marshal -- Convert Tcl schemas to KEKS representation +# Copyright (C) 2024-2025 Sergey Matveev +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Lesser General Public License as +# published by the Free Software Foundation, version 3 of the License. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with this program. If not, see . + +source [file join [file dirname $::argv0] keks.tcl] +namespace import KEKS::* + +proc TAKE {k} { + if {[string is digit $k]} { + set v [list INT $k] + } { + set v [list STR $k] + } + subst {LIST {{STR .} {$v}}} +} +proc EXISTS {} {return {LIST {{STR E}}}} +proc !EXISTS {} {return {LIST {{STR !E}}}} +proc EACH {} {return {LIST {{STR *}}}} +proc EQ {v} {subst {LIST {{STR =} {BIN $v}}}} +proc TYPE {types} { + set l {{STR T}} + foreach t $types { + lappend l [list STR [string toupper $t]] + } + subst {LIST {$l}} +} +proc GT {n} {subst {LIST {{STR >} {INT $n}}}} +proc LT {n} {subst {LIST {{STR <} {INT $n}}}} +proc SCHEMA {s} {subst {LIST {{STR S} {STR $s}}}} +proc TIMEPREC {p} {subst {LIST {{STR TP} {INT $p}}}} +proc UTC {} {return {LIST {{STR UTC}}}} + +proc schema-process {v} { + upvar _pairs _pairs + foreach {name cmds} $v { + set _cmds {} + if {$name == "schema-include"} { + set fd [open [file join $cmds]] + set inc [read $fd] + close $fd + schema-process $inc + continue + } + foreach cmd $cmds {eval $cmd} + lappend _pairs $name [list LIST $_cmds] + } +} + +proc schemas {v} { + set _pairs {} + schema-process $v + MAP $_pairs +} + +set timeprecArgs [dict create s 0 ms 3 us 6 ns 9 ps 12 fs 15 as 18] +set knownTypes {bin blob bool hexlet int list magic map nil set str tai} + +proc field {k types args} { + upvar _cmds _cmds + if {[lindex $types 0] == "with"} { + lappend _cmds [TAKE $k] + lappend _cmds [SCHEMA [lindex $types 1]] + } elseif {[lsearch -exact $types set] == -1} { + if {[llength $types] != 0} { + lappend _cmds [TAKE $k] + lappend _cmds [TYPE $types] + } + } else { + if {[llength $types] != 1} { + error "set can be the only one among types" + } + lappend _cmds [TAKE $k] + lappend _cmds [TYPE {MAP}] + lappend _cmds [TAKE $k] + lappend _cmds [EACH] + lappend _cmds [TYPE {NIL}] + } + if {[lsearch -exact $args !exists] != -1} { + lappend _cmds [TAKE $k] + lappend _cmds [!EXISTS] + } elseif {[lsearch -exact $args optional] == -1} { + lappend _cmds [TAKE $k] + lappend _cmds [EXISTS] + } + set i [lsearch -glob $args "len=*"] + if {$i != -1} { + set n [string range [lindex $args $i] 4 end] + lappend _cmds [TAKE $k] + lappend _cmds [GT [expr {$n - 1}]] + lappend _cmds [TAKE $k] + lappend _cmds [LT [expr {$n + 1}]] + } + set i [lsearch -glob $args ">*"] + if {$i != -1} { + lappend _cmds [TAKE $k] + lappend _cmds [GT [string range [lindex $args $i] 1 end]] + } + set i [lsearch -glob $args "<*"] + if {$i != -1} { + lappend _cmds [TAKE $k] + lappend _cmds [LT [string range [lindex $args $i] 1 end]] + } + set i [lsearch -glob $args "prec=*"] + if {$i != -1} { + set p [string range [lindex $args $i] 5 end] + global timeprecArgs + set p [dict get $timeprecArgs $p] + lappend _cmds [TAKE $k] + lappend _cmds [TIMEPREC $p] + } + if {[lsearch -exact $args utc] != -1} { + lappend _cmds [TAKE $k] + lappend _cmds [UTC] + } + set i [lsearch -glob $args "=*"] + if {$i != -1} { + lappend _cmds [TAKE $k] + lappend _cmds [EQ [string range [lindex $args $i] 1 end]] + } + set i [lsearch -glob $args "of *"] + if {$i != -1} { + set s [lindex [lindex $args $i] 1] + lappend _cmds [TAKE $k] + lappend _cmds [EACH] + global knownTypes + if {[lsearch -exact $knownTypes $s] == -1} { + lappend _cmds [SCHEMA $s] + } { + lappend _cmds [TYPE $s] + } + } +} + +set _schema {} +foreach f $::argv {lappend _schema schema-include $f} +MAGIC schema +schemas $_schema +puts [binary encode hex $::KEKS::buf] diff --git a/tcl/schema2bin b/tcl/schema2bin deleted file mode 100755 index 23f4d1a..0000000 --- a/tcl/schema2bin +++ /dev/null @@ -1,143 +0,0 @@ -#!/usr/bin/env tclsh -# schema2bin -- Convert Tcl schemas to KEKS representation -# Copyright (C) 2024-2025 Sergey Matveev -# -# This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU Lesser General Public License as -# published by the Free Software Foundation, version 3 of the License. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU Lesser General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public -# License along with this program. If not, see . - -source [file join [file dirname $::argv0] keks.tcl] -namespace import KEKS::* - -proc TAKE {v} { - if {[string is digit $v]} { - set v [list INT $v] - } { - set v [list STR $v] - } - subst {{LIST {{STR .} {$v}}}} -} -proc EXISTS {} {return {{LIST {{STR E}}}}} -proc !EXISTS {} {return {{LIST {{STR !E}}}}} -proc EACH {} {return {{LIST {{STR *}}}}} -proc EQ {v} {subst {{LIST {{STR =} {BIN $v}}}}} -proc TYPE {vs} { - set l {{STR T}} - foreach v $vs { - lappend l "STR $v" - } - subst {{LIST {$l}}} -} -proc GT {v} {subst {{LIST {{STR >} {INT $v}}}}} -proc LT {v} {subst {{LIST {{STR <} {INT $v}}}}} -proc SCHEMA {v} {subst {{LIST {{STR S} {STR $v}}}}} -proc TIMEMAXPREC {v} {subst {{LIST {{STR TMP} {INT $v}}}}} - -proc evals {cmds} { - set rv {} - foreach cmd $cmds { - set rv [concat $rv [eval $cmd]] - } - return $rv -} - -proc SCHEMAS {v} { - set pairs {} - foreach {name cmds} $v { - lappend pairs $name [list LIST [evals $cmds]] - } - MAP $pairs -} - -proc HAS {k} { - evals [subst { - {TAKE $k} - {EXISTS} - }] -} - -proc !HAS {k} { - evals [subst { - {TAKE $k} - {!EXISTS} - }] -} - -proc STR= {k v} { - evals [subst { - {TAKE $k} - {TYPE {STR}} - {TAKE $k} - {EQ $v} - }] -} - -proc LEN= {k l} { - evals [subst { - {TAKE $k} - {GT [expr {$l - 1}]} - {TAKE $k} - {LT [expr {$l + 1}]} - }] -} - -proc TYPE= {k types} { - evals [subst { - {TAKE $k} - {TYPE {$types} - }}] -} - -proc TYPE* {k types} { - evals [subst { - {TAKE $k} - {EACH} - {TYPE {$types}} - }] -} - -proc SCHEMA= {k schema} { - evals [subst { - {TAKE $k} - {SCHEMA $schema} - }] -} - -proc SCHEMA* {k schema} { - evals [subst { - {TAKE $k} - {EACH} - {SCHEMA $schema} - }] -} - -proc !EMPTY {k} { - evals [subst { - {TAKE $k} - {GT 0} - }] -} - -proc IS-SET {k} { - evals [subst { - {TAKE $k} - {TYPE {MAP}} - {TAKE $k} - {GT 0} - {TAKE $k} - {EACH} - {TYPE {NIL}} - }] -} - -MAGIC schema -source [lindex $::argv 0] -puts [binary encode hex $::KEKS::buf] diff --git a/tcl/schemas/av.tcl b/tcl/schemas/av.tcl new file mode 100644 index 0000000..bc20f0c --- /dev/null +++ b/tcl/schemas/av.tcl @@ -0,0 +1,5 @@ +av { + {field . {map}} + {field a {str} >0} {# algorithm identifier} + {field v {bin}} +} diff --git a/tcl/schemas/encrypted.tcl b/tcl/schemas/encrypted.tcl index 4c218c3..21e0cbe 100644 --- a/tcl/schemas/encrypted.tcl +++ b/tcl/schemas/encrypted.tcl @@ -1,65 +1,50 @@ -SCHEMAS { - encrypted { - {HAS dem} - {HAS kem} - {TYPE= id {HEXLET}} - {TYPE= payload {BIN}} - {TYPE= dem {MAP}} - {TYPE= kem {LIST}} - {!EMPTY kem} - {SCHEMA= dem dem} - {SCHEMA* kem kem} + {field dem {with dem}} + {field kem {list} {of kem} >0} + {field id {hexlet} optional} + {field payload {bin} optional} } dem { - {HAS a} - {TYPE= a {STR}} - {!EMPTY a} + {field . {map}} + {# chapoly-krkc} + {# kuznechik-ctr-hmac-kr} + {field a {str} >0} } kem { - {HAS a} - {TYPE= a {STR}} - {!EMPTY a} - {HAS cek} - {TYPE= cek {BIN}} + {field a {str} >0} + {field cek {bin} >0} } balloon-cost { - {HAS s} - {HAS t} - {HAS p} - {TYPE= s INT} - {TYPE= t INT} - {TYPE= p INT} + {field s {int} >0} {# space cost} + {field t {int} >0} {# time cost} + {field p {int} >0} {# parallel cost} } kem-balloon-blake2b-hkdf { - {HAS a} - {STR= a balloon-blake2b-hkdf} - {HAS cek} - {TYPE= cek {BIN}} - {HAS salt} - {TYPE= salt {BIN}} - {HAS cost} - {SCHEMA= cost balloon-cost} + {field a {str} =balloon-blake2b-hkdf} + {field cek {bin} >0} + {field salt {bin} >0} + {field cost {with balloon-cost}} } -fpr { - {TYPE= . {BIN}} - {LEN= . 32} +kem-gost3410-hkdf-kexp15 { + {field a {str} =gost3410-hkdf-kexp15} + {field cek {bin} >0} + {field ukm {bin} >0} + {field pub {bin} >0} + {field to {with fpr} optional} {# recipient's public key} } kem-with-encap { - {HAS a} - {TYPE= a {STR}} - {!EMPTY a} - {HAS cek} - {TYPE= cek {BIN}} - {HAS encap} - {TYPE= encap {BIN}} - {SCHEMA= to fpr} + {# sntrup4591761-x25519-hkdf-blake2b} + {# mceliece6960119-x25519-hkdf-shake256} + {field a {str} >0} + {field cek {bin} >0} + {field encap {bin} >0} + {field to {with fpr} optional} {# recipient's public key} } -} +schema-include fpr.tcl diff --git a/tcl/schemas/fpr.tcl b/tcl/schemas/fpr.tcl new file mode 100644 index 0000000..dcef9b3 --- /dev/null +++ b/tcl/schemas/fpr.tcl @@ -0,0 +1 @@ +fpr {{field . {bin} len=32}} diff --git a/tcl/schemas/hashed.tcl b/tcl/schemas/hashed.tcl new file mode 100644 index 0000000..1a10da8 --- /dev/null +++ b/tcl/schemas/hashed.tcl @@ -0,0 +1,8 @@ +ai {{field . {str} >0}} + +hashed { + {field a {list} {of ai} >0} + {field t {str} >0} + {field v {bin blob} optional} + {field hash {list} {of bin} >0} +} diff --git a/tcl/schemas/pub-load.tcl b/tcl/schemas/pub-load.tcl new file mode 100644 index 0000000..167cac5 --- /dev/null +++ b/tcl/schemas/pub-load.tcl @@ -0,0 +1,8 @@ +pub-load { + {field . {map}} + {field id {with fpr}} + {field crit {} !exists} + {field ku {set} >0 optional} + {field pub {list} {of av} >0} + {field sub {map} {of str} >0} +} diff --git a/tcl/schemas/pub-sig-tbs.tcl b/tcl/schemas/pub-sig-tbs.tcl new file mode 100644 index 0000000..60e6efb --- /dev/null +++ b/tcl/schemas/pub-sig-tbs.tcl @@ -0,0 +1,11 @@ +exp-tai {{field . {tai} prec=s utc}} +expiration {{field . {list} {of exp-tai} len=2}} + +pub-sig-tbs { + {field . {map}} + {field sid {with fpr}} + {field cid {hexlet}} + {field exp {with expiration}} + {field nonce {bin} >0 optional} + {field when {tai} utc optional} +} diff --git a/tcl/schemas/pub.tcl b/tcl/schemas/pub.tcl index 4ca815a..827e640 100644 --- a/tcl/schemas/pub.tcl +++ b/tcl/schemas/pub.tcl @@ -1,85 +1,26 @@ -SCHEMAS { - -av { - {HAS a} - {TYPE= a {STR}} - {!EMPTY a} - {HAS v} - {TYPE= v {BIN}} -} - pub { - {HAS load} - {SCHEMA= load load} - {TYPE= sigs {LIST}} - {SCHEMA* sigs sig} - - {TYPE= pubs {LIST}} - {!EMPTY pubs} - {SCHEMA* pubs pub} + {field load {with load}} + {field sigs {list} {of sig} >0 optional} + {field pubs {list} {of pub} >0 optional} } load { - {HAS t} - {STR= t pub} - {HAS v} - {SCHEMA= v pub-load} -} - -sig { - {HAS tbs} - {HAS sign} - {SCHEMA= tbs tbs} - {SCHEMA= sign av} -} - -exp { - {TYPE= . {LIST}} - {LEN= . 2} - {TYPE* . {TAI64}} - {TAKE .} - {EACH} - {TIMEMAXPREC 0} -} - -fpr { - {TYPE= . {BIN}} - {LEN= . 32} + {field . {map}} + {field t {str} =pub} + {field v {with pub-load}} } -tbs { - {HAS sid} - {SCHEMA= sid fpr} - - {HAS cid} - {TYPE= cid {HEXLET}} - - {HAS exp} - {SCHEMA= exp exp} - - {TYPE= nonce {BIN}} - {!EMPTY nonce} - - {TYPE= when {TAI64}} +av { + {field . {map}} + {field a {str} >0} + {field v {bin}} } -pub-load { - {HAS id} - {SCHEMA= id fpr} - - {!HAS crit} - - {IS-SET ku} - - {HAS pub} - {TYPE= pub {LIST}} - {!EMPTY pub} - {SCHEMA* pub av} - - {HAS sub} - {TYPE= sub {MAP}} - {!EMPTY sub} - {TYPE* sub {STR}} +sig { + {field tbs {with pub-sig-tbs}} + {field sign {with av}} } -} +schema-include fpr.tcl +schema-include pub-load.tcl +schema-include pub-sig-tbs.tcl diff --git a/tcl/schemas/signed-prehash.tcl b/tcl/schemas/signed-prehash.tcl new file mode 100644 index 0000000..7b884c5 --- /dev/null +++ b/tcl/schemas/signed-prehash.tcl @@ -0,0 +1,5 @@ +prehash { + {field t {str} =prehash} + {# set of signature algorithm identifiers (/sigs/*/sign/a)} + {field sigs {set} >0} +} diff --git a/tcl/schemas/signed.tcl b/tcl/schemas/signed.tcl index ea11e97..8af5736 100644 --- a/tcl/schemas/signed.tcl +++ b/tcl/schemas/signed.tcl @@ -1,59 +1,30 @@ -SCHEMAS { - -prehash { - {HAS t} - {TYPE= t {STR}} - {HAS sigs} - {IS-SET sigs} -} - -av { - {HAS a} - {TYPE= a {STR}} - {!EMPTY a} - {HAS v} - {TYPE= v {BIN}} -} +schema-include av.tcl +schema-include fpr.tcl signed { - {HAS load} - {SCHEMA= load load} - {TYPE= sigs {LIST}} - {SCHEMA* sigs sig} - - {TYPE= pubs {LIST}} - {!EMPTY pubs} + {field load {with load}} + {field sigs {list} {of sig} >0 optional} + {field pubs {list} {of map} >0 optional} } load { - {HAS t} - {TYPE= t {STR}} - {!EMPTY t} + {field . {map}} + {field t {str} >0} } sig { - {HAS tbs} - {HAS sign} - {SCHEMA= tbs tbs} - {SCHEMA= sign av} -} - -fpr { - {TYPE= . {BIN}} - {LEN= . 32} + {field tbs {with tbs}} + {field sign {with av}} } tbs { - {HAS sid} - {TYPE= sid {BIN}} - {LEN= sid 32} - {TYPE= nonce {BIN}} - {!EMPTY nonce} - {TYPE= when {TAI64}} + {field . {map}} + {field sid {with fpr}} + {field nonce {bin} >0 optional} {# random bytes} + {field when {tai} utc optional} - {TYPE= encrypted-to {LIST}} - {!EMPTY encrypted-to} - {SCHEMA* encrypted-to fpr} + {# recipient's fingerprints} + {field encrypted-to {list} {of fpr} >0 optional} } -} +schema-include signed-prehash.tcl -- 2.48.1