object class
    field: token-table
    value: parent
    value: my-key        \ key used for this context
    field: req?
    field: c-state \ state for checks whether everything is there
    method start-req
    method nest-sig \ check sig first and then nest
end-class cmd-class \ command interpreter
' noop cmd-class to start-req
:noname ( addr u -- flag ) 2drop -1 ; cmd-class to nest-sig

Variable cmd-table
Variable reply-table
Variable log-table
................................................................................
    64field: max-slack
    64field: time-offset  \ make timestamps smaller
    64field: lastdeltat
end-class ack-class

cmd-class class
    field: peers[]

    field: silent-last#

end-class msging-class

cmd-class class{ msg
    $value: id$
    method start
    method tag
    method chain

object class
    field: token-table
    value: parent
    value: my-key        \ key used for this context
    field: req?
    field: c-state \ state for checks whether everything is there
    method start-req
    method nest-sig     \ check sig first and then nest
end-class cmd-class \ command interpreter
' noop cmd-class to start-req
:noname ( addr u -- flag ) 2drop -1 ; cmd-class to nest-sig

Variable cmd-table
Variable reply-table
Variable log-table
................................................................................
    64field: max-slack
    64field: time-offset  \ make timestamps smaller
    64field: lastdeltat
end-class ack-class

cmd-class class
    field: peers[]
    field: msg-keys[]
    field: silent-last#
    method dec-nest-sig \ check sig, decrypt and then nest
end-class msging-class

cmd-class class{ msg
    $value: id$
    method start
    method tag
    method chain

    keysize   uvar stskc
    keypack-all# uvar keypack-d
    $100      uvar vaultkey \ buffers for vault
    $100      uvar keydump-buf  \ buffer for dumping keys
    state2#   uvar vkey \ maximum size for session key
    state2#   uvar voutkey \ for keydump
    keysize   uvar keygendh
    keysize   uvar vpk
    keysize   uvar vsk
    tf_ctx_256 uvar tf-key
    keysize   uvar tf-out
    $10       uvar tf-hashout
    1 64s     uvar last-mykey
    cell      uvar keytmp-up
end-class keytmp-c

................................................................................
	4 to mode
    keysize +LOOP  0 0 ;
: v-dec$ ( addr u -- session-key u / 0 0 )
    over >vdhe keysize /string
    over >viv  $10 /string
    v-dec-loop ;

: vdhe ( -- )  vsk vpk ed-keypair  vpk keysize type ;
: viv  ( -- )  $10 rng$ 2dup type  tf-key tf_ctx_256-tweak swap move ;
: vsessionkey ( -- )
    keysize rng$ vkey state# move-rep
    c:0key vkey keysize c:hash tf-hashout $10 2dup c:hash@ type ;
: v-enc-loop ( keylist -- )
    [:  drop vsk swap tf-key tf_ctx_256-key ed-dh 2drop
	tf-key vkey tf-out $C tf_encrypt_256
	tf-out keysize type
	tf-key tf_tweak256++
    ;] $[]map ;
: v-enc-gen ( keylist -- )
    vdhe viv vsessionkey v-enc-loop ;
: v-enc$ ( keylist -- addr u )

    keysize   uvar stskc
    keypack-all# uvar keypack-d
    $100      uvar vaultkey \ buffers for vault
    $100      uvar keydump-buf  \ buffer for dumping keys
    state2#   uvar vkey \ maximum size for session key
    state2#   uvar voutkey \ for keydump
    keysize   uvar keygendh


    tf_ctx_256 uvar tf-key
    keysize   uvar tf-out
    $10       uvar tf-hashout
    1 64s     uvar last-mykey
    cell      uvar keytmp-up
end-class keytmp-c

................................................................................
	4 to mode
    keysize +LOOP  0 0 ;
: v-dec$ ( addr u -- session-key u / 0 0 )
    over >vdhe keysize /string
    over >viv  $10 /string
    v-dec-loop ;

: vdhe ( -- )  stskc stpkc ed-keypair  stpkc keysize type ;
: viv  ( -- )  $10 rng$ 2dup type  tf-key tf_ctx_256-tweak swap move ;
: vsessionkey ( -- )
    keysize rng$ vkey state# move-rep
    c:0key vkey keysize c:hash tf-hashout $10 2dup c:hash@ type ;
: v-enc-loop ( keylist -- )
    [:  drop stskc swap tf-key tf_ctx_256-key ed-dh 2drop
	tf-key vkey tf-out $C tf_encrypt_256
	tf-out keysize type
	tf-key tf_tweak256++
    ;] $[]map ;
: v-enc-gen ( keylist -- )
    vdhe viv vsessionkey v-enc-loop ;
: v-enc$ ( keylist -- addr u )

#!/bin/bash

echo "This script builds net2o from scratch"

GFORTH=gforth-0.7.9_20190530

if [ "$(uname -o)" = "Cygwin" ]
then
    CONFOPT="--prefix=/usr $*"
else
    CONFOPT="$*"
fi

#!/bin/bash

echo "This script builds net2o from scratch"

GFORTH=gforth-0.7.9_20190606

if [ "$(uname -o)" = "Cygwin" ]
then
    CONFOPT="--prefix=/usr $*"
else
    CONFOPT="$*"
fi

\    ." admin " groups:admin[] [: '@' emit .simple-id space ;] $[]map
    ." +" groups:perms# x64.
    o> cr ;
: .chatgroups ( -- )
    groups>sort[]
    group-list[] $@ bounds ?DO  I @ .chatgroup  cell +LOOP ;














\g 
\g ### messaging commands ###
\g 

scope{ net2o-base

$34 net2o: message ( -- o:msg ) \g push a message object
................................................................................
	parent last# cell+ del$cell  THEN ;
+net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree
    $> $make
    <event last-msg 2@ e$, elit, o elit, last# elit, :>chat-reconnect
    parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;


: ?pkgroup ( addr u -- addr u )
    \ if no group has been selected, use the pubkey as group
    last# 0= IF  2dup + sigpksize# - keysize >group  THEN ;

net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
    $> nest-sig ?dup-0=-IF
	?pkgroup >msg-log
	2dup d0<> \ do something if it is new
	IF  replay-mode @ 0= IF
		2dup show-msg
		2dup parent .push-msg
	    THEN
	THEN  2drop
    ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;


:noname skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
    ELSE  pk-sig?  THEN ;  ' message  2dup

msging-class to start-req
msging-class to nest-sig
msg-class to start-req
msg-class to nest-sig



















' context-table is gen-table

also }scope

msging-table $save

\    ." admin " groups:admin[] [: '@' emit .simple-id space ;] $[]map
    ." +" groups:perms# x64.
    o> cr ;
: .chatgroups ( -- )
    groups>sort[]
    group-list[] $@ bounds ?DO  I @ .chatgroup  cell +LOOP ;

: ?pkgroup ( addr u -- addr u )
    \ if no group has been selected, use the pubkey as group
    last# 0= IF  2dup + sigpksize# - keysize >group  THEN ;

: handle-msg ( addr u -- )
    ?pkgroup >msg-log
    2dup d0<> \ do something if it is new
    IF  replay-mode @ 0= IF
	    2dup show-msg
	    2dup parent .push-msg
	THEN
    THEN  2drop ;

\g 
\g ### messaging commands ###
\g 

scope{ net2o-base

$34 net2o: message ( -- o:msg ) \g push a message object
................................................................................
	parent last# cell+ del$cell  THEN ;
+net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree
    $> $make
    <event last-msg 2@ e$, elit, o elit, last# elit, :>chat-reconnect
    parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;

+net2o: msg-key ( $:key -- )
    $> v-dec$ dup IF  msg-keys[] $+[]!  ELSE  2drop  THEN ;



net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
    $> nest-sig ?dup-0=-IF
	handle-msg
   ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;
+net2o: msg-nestencsig ( $:enc[cmd]+sig -- ) \g decrypt, chech sig+nest
    $> dec-nest-sig ?dup-0=-IF
	handle-msg
   ELSE  replay-mode @ IF  drop 2drop
	ELSE  !!sig!!  THEN \ balk on all wrong signatures
    THEN ;

: msg-sig? ( addr u -- addr u' flag )
    skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )
    ELSE  pk-sig?  THEN ;
' msg-sig? ' message  2dup
msging-class to start-req
msging-class to nest-sig
msg-class to start-req
msg-class to nest-sig

: msg-dec-sig? ( addr u -- addr' u' flag )
    msg-sig? dup  IF  drop
	2dup + pktmp keysize move \ move the pk to pktmp
	get0 pktmp ge25519-unpack- 0= !!no-ed-key!!
	msg-keys[] $@ bounds U+DO
	    2dup I $@ crypt-key-init $>align
	    2dup 0 c:decrypt+auth IF
		voutkey keysize c:hash@
		sct0 voutkey 32b>sc25519
		get1 get0 sct0 ge25519*
		tf-out get1 ge25519-pack
		$80 tf-out $1F + xorc!
		2nip true unloop  EXIT  THEN
	    2drop
	cell +LOOP
	false
    THEN ;

' context-table is gen-table

also }scope

msging-table $save

: enc>crypt2 ( -- )
    enc-mode @ $10 rshift $FF and >crypt ;

enc-keccak

: pk-off ( -- ) key-list $[]off ;

: vdhe, ( -- )   vsk vpk ed-keypair vpk keysize $, dhe ;
: vkeys, ( key-list -- )
    vaultkey $100 erase
    enc-mode @ $FF and $20 - rng$ vkey state# move-rep
    vkey( ." vkey key: " vkey state# 85type forth:cr )
    enc-mode @ dup ulit, vault-crypt 8 rshift $FF and >crypt
    [: [: drop vsk swap keygendh ed-dh 2>r
	    vkey vaultkey $10 + enc-mode @ $FF and $20 - move
	    vaultkey enc-mode @ $FF and 2r> encrypt$
	    vaultkey enc-mode @ $FF and forth:type ;] $[]map ;] $tmp
    $, vault-keys 0 >crypt ;
: vdhe-keys, ( key-list -- )
    v-enc$ $, vault-dhe-keys  0 >crypt ;
: vfile-in ( -- )

: enc>crypt2 ( -- )
    enc-mode @ $10 rshift $FF and >crypt ;

enc-keccak

: pk-off ( -- ) key-list $[]off ;

: vdhe, ( -- )   stskc stpkc ed-keypair stpkc keysize $, dhe ;
: vkeys, ( key-list -- )
    vaultkey $100 erase
    enc-mode @ $FF and $20 - rng$ vkey state# move-rep
    vkey( ." vkey key: " vkey state# 85type forth:cr )
    enc-mode @ dup ulit, vault-crypt 8 rshift $FF and >crypt
    [: [: drop stskc swap keygendh ed-dh 2>r
	    vkey vaultkey $10 + enc-mode @ $FF and $20 - move
	    vaultkey enc-mode @ $FF and 2r> encrypt$
	    vaultkey enc-mode @ $FF and forth:type ;] $[]map ;] $tmp
    $, vault-keys 0 >crypt ;
: vdhe-keys, ( key-list -- )
    v-enc$ $, vault-dhe-keys  0 >crypt ;
: vfile-in ( -- )

  if blockwise, there may be multiple parts
* $23 vault-sig ( $:sig -- )
  the signature of the vault, using the keyed hash over the file
* $24 vault-crypt ( n -- )
  set encryption mode and key wrap size
* $25 vault-auth ( $:auth -- )
  block authentication, 64 byte block


### message commands ###

* $20 msg-start ( $:pksig -- )
  start message
* $21 msg-tag ( $:tag -- )
  tagging (can be anywhere)
................................................................................
  join a chat group
* $23 msg-leave ( $:group -- )
  leave a chat group
* $24 msg-reconnect ( $:pubkey+addr -- )
  rewire distribution tree
* $25 msg-last? ( start end n -- )
* $26 msg-last ( $:[tick0,msgs,..tickn] n -- )

* $A msg-nestsig ( $:cmd+sig -- )
  check sig+nest



### DVCS patch commands ###

DVCS metadata is stored in messages, containing message text, refs
and patchset objects. Patchset objects are constructed in a way
that makes identical transactions have the same hash.

  if blockwise, there may be multiple parts
* $23 vault-sig ( $:sig -- )
  the signature of the vault, using the keyed hash over the file
* $24 vault-crypt ( n -- )
  set encryption mode and key wrap size
* $25 vault-auth ( $:auth -- )
  block authentication, 64 byte block
* $26 vault-dhe-keys ( $:dhe+keys -- )

### message commands ###

* $20 msg-start ( $:pksig -- )
  start message
* $21 msg-tag ( $:tag -- )
  tagging (can be anywhere)
................................................................................
  join a chat group
* $23 msg-leave ( $:group -- )
  leave a chat group
* $24 msg-reconnect ( $:pubkey+addr -- )
  rewire distribution tree
* $25 msg-last? ( start end n -- )
* $26 msg-last ( $:[tick0,msgs,..tickn] n -- )
* $27 msg-key ( $:key -- )
* $A msg-nestsig ( $:cmd+sig -- )
  check sig+nest
* $28 msg-nestencsig ( $:enc[cmd]+sig -- )
  decrypt, chech sig+nest

### DVCS patch commands ###

DVCS metadata is stored in messages, containing message text, refs
and patchset objects. Patchset objects are constructed in a way
that makes identical transactions have the same hash.