#!/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
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
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
+#include <assert.h>
#include <stddef.h>
#include <stdint.h>
#include <string.h>
&(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;
}
#include <stddef.h>
#include <stdint.h>
#include <string.h>
+#include <time.h>
#include "atom.h"
+#include "dectai.h"
+#include "err.h"
#include "frombe.h"
#include "items.h"
#include "schema.h"
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";
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(
} 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)) {
}
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;
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 {
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;
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
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
)
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"
)
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)
return fmt.Errorf("%s: %d: %d: %s: %w", schemaName, i, n, cmd, err)
}
}
- case CmdTimeMaxPrec:
+ case CmdTimePrec:
if vs == nil {
continue
}
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)
}
+++ /dev/null
-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
-}
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
+++ /dev/null
-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
-}
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.
@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
+++ /dev/null
-ai = text .ge 0 ; algorithm identifier
-av = {a: ai, v: bytes}
-
-cm-prv = av
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}.
+++ /dev/null
-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
+++ /dev/null
-validity = [since: tai64, till: tai64]
-
-cm-pub-sig-tbs = {
- cid: uuid, ; certification id
- exp: validity,
- sid: fpr, ; signer's public key fingerprint
- * text => any
-}
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
@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
+++ /dev/null
-cm-signed-prehash = {
- t: "prehash",
- sigs: set, ; set of signature algorithm identifiers (/sigs/*/sign/a)
-}
+++ /dev/null
-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
-}
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:
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!)
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;
@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:
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": [
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{<n} arguments allow checking of the integer value or
+the lengths. @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.
--- /dev/null
+#!/usr/bin/env tclsh
+# schema-marshal -- Convert Tcl schemas to KEKS representation
+# Copyright (C) 2024-2025 Sergey Matveev <stargrave@stargrave.org>
+#
+# 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 <http://www.gnu.org/licenses/>.
+
+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]
+++ /dev/null
-#!/usr/bin/env tclsh
-# schema2bin -- Convert Tcl schemas to KEKS representation
-# Copyright (C) 2024-2025 Sergey Matveev <stargrave@stargrave.org>
-#
-# 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 <http://www.gnu.org/licenses/>.
-
-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]
--- /dev/null
+av {
+ {field . {map}}
+ {field a {str} >0} {# algorithm identifier}
+ {field v {bin}}
+}
-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
--- /dev/null
+fpr {{field . {bin} len=32}}
--- /dev/null
+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}
+}
--- /dev/null
+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}
+}
--- /dev/null
+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}
+}
-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
--- /dev/null
+prehash {
+ {field t {str} =prehash}
+ {# set of signature algorithm identifiers (/sigs/*/sign/a)}
+ {field sigs {set} >0}
+}
-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