;
+net2o: request-qr-invitation ( -- )
    \g ask for an invitation as second stage of invitation handshake
    own-crypt? IF  qr-invite-me  THEN ;
+net2o: tmp-secret, ( -- )
    nest[ sec-cookie, ]nest ;
+net2o: qr-challenge ( $:challenge $:respose -- )
    \ !!FIXME!! the qr-challenge should include pubkey+sig into the hash
    $> $> c:0key qr-key $8 >keyed-hash qr-hash $40 c:hash@
    qr-hash over $10 umax str= dup invit:qr# and ulit, <invite-result>
    \ challenge will fail if less than 16 bytes
    IF  msg( ." challenge accepted" forth:cr )
	qr-tmp-val validated or!
    ELSE
	msg( ." challenge failed: " qr-hash $40 85type

$FFFFFFFF new-color: edit-bg
$80FF80FF new-color: send-color
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
$FFCCCCFF new-color, fvalue gps-color#
$000077FF new-color, fvalue chain-color#
$FF000000 $FF0000FF fade-color: show-error-color
$338833FF text-color: lock-color
$883333FF text-color: lockout-color

: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

Hash: avatar#

glue new Constant glue*avatar

    string ['] utf8-sanitize $tmp }}text _underline_ 25%bv
    text-color!
    [: data >o text$ o> open-url ;]
    over click[]
    click( ." url: " dup ..parents cr )
    "url" name! msg-box .child+
; wmsg-class is msg:url
:noname ( d: string -- o )
    0 .v-dec$ dup IF
	msg-key!  msg-group-o .msg:+lock
	{{
	    glue*l lock-color x-color slide-frame dup .button1
	    greenish l" chat is locked" }}text' 25%bv
	}}z
    ELSE  2drop
	{{
	    glue*l lockout-color x-color slide-frame dup .button1
	    show-error-color 1e +to x-color l" locked out of chat" }}text' 25%bv
	}}z
    THEN "lock" name! msg-box .child+ ; wmsg-class is msg:lock
:noname ( -- o )
	{{
	    glue*l lock-color x-color slide-frame dup .button1
	    blackish l" chat is unlocked" }}text' 25%bv
	}}z msg-box .child+ ;
:noname { d: string -- o }
    {{
	glue*l gps-color# slide-frame dup .button1
	string [: ."  GPS: " .coords ;] $tmp }}text 25%b
    }}z "gps" name! msg-box .child+
; wmsg-class is msg:coord
:noname { d: string -- o }

: (gui-msgs) ( gaddr u -- )
    reset-time
    64#0 to last-tick  last-bubble-pk $free
    0 to msg-par  0 to msg-box
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+
    2dup load-msg
    gui-msgs# msg-log@
    { log u } u r> - 0 max { u' }  log u' ?search-lock
    log u u' /string bounds ?DO
	I $@ { d: msgt }
	msgt ['] wmsg-display wmsg-o .catch IF
	    <err> ." invalid entry" <default> 2drop
	THEN
    cell +LOOP
    log free throw  msgs-box >o resized vp-bottom o>
    chat-edit engage ;

    ret0 net2o:new-context >o rdrop dest-pk ;

in net2o : pklookup? ( pkaddr u -- flag )
    2dup keysize2 safe/string hostc$ $! key2| 2dup pkc over str= to ?myself
    2dup >d#id { id }
    id .dht-host $[]# 0= IF  2dup pk-lookup  2dup >d#id to id  THEN
    2dup make-context
    false id dup .dht-host ['] insert-host? $[]map drop nip nip ;

in net2o : pklookup ( pkaddr u -- )
    net2o:pklookup? 0= !!no-address!! ;

: ?nat-done ( n -- )
    nat( ." req done, issue nat request" forth:cr )
    connect-rest +flow-control +resend ?nat ;
: no-nat-done ( n -- )

also net2o-base

: invite-me ( -- )
    [: 0key, nest[ mypk2nick$ $, pubkey $@ key| $, invite cookie+request
      ]tmpnest end-cmd ;] is expect-reply? ;
: qr-challenge, ( -- )
    \ !!FIXME!! the qr-challenge should include pubkey+sig into the hash
    $10 rng$ 2dup $, qr-key $8
    msg( ." challenge: " 2over 85type space 2dup xtype forth:cr )
    c:0key >keyed-hash
    qr-hash $40 c:hash@ qr-hash $10 $, qr-challenge ;
: qr-invite-me ( -- )
    [: 0key, nest[ qr-challenge,
      mypk2nick$ $, pubkey $@ key| $, invite cookie+request

Spitznamen
Öffentlicher Schlüssel
Schlüsselsignaturdatum
Meine Schlüssel
Meine Gruppen
Meine Freunde
Posting




Niemand ist online, speichere weg

Einladungen

Nick+Pet
Pubkey
Key date
My key
My groups
My peers
Post




Nobody is online

Invitations

昵称
公钥
关键签名日期
我的钥匙
我的集团
我的朋友
贴子




没有人在线，保存了
发送
请帖

    sigpksize# - 2dup + { pksig }
    msg-group-o .msg:keys[] $@ bounds U+DO
	I $@ 2over pksig decrypt-sig?
	dup -5 <> IF
	    >r 2nip r> unloop  EXIT
	THEN  drop 2drop
    cell +LOOP
    sigpksize# +  -5 ;

: msg-dec?-sig? ( addr u -- addr' u' flag )
    2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;

\ generate an encryt+sign packet

: ]encpksign ( -- )
    +zero16 nest$
    0 msg-group-o .msg:keys[] $[]@ encrypt$
    ['] .encsign ']nestsig ;

\ nest-sig for msg/msging classes


' message msging-class is start-req
:noname check-date >r 2dup r> ; msging-class is nest-sig
' message msg-class is start-req
' msg-dec?-sig? msg-class is nest-sig

' context-table is gen-table

also }scope

msging-table $save

: group, ( addr u -- )
    $, msg-group ;
: <msg ( -- )
    sign[ msg-group-o .msg:?lock IF  +zero16  THEN ;

: msg> ( -- )
    \G end a message block by adding a signature
    msg-group-o .msg:?lock IF  ]encpksign  ELSE  ]pksign  THEN ;
: msg-otr> ( -- )
    \G end a message block by adding a short-time signature
    now>otr msg> ;
: msg-log, ( -- addr u )
    last-signed 2@ >msg-log ;

previous

    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: ?search-lock ( addr u -- )
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN
    REPEAT  2drop ;
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o >o msg:?otr msg:-otr o> >r
    [:  cells >r msg-log@
	{ log u } u r> - 0 max { u' }  log u' ?search-lock
	log u u' /string bounds ?DO
	    I log - cell/ to log#
	    I $@ { d: msgt }
	    msgt ['] msg:display catch IF  ." invalid entry" cr
		2drop  THEN
	cell +LOOP
	log free throw ;] catch
    r> IF  msg-group-o .msg:+otr  THEN  throw ;

    msg-group-o .msg:-lock
    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize $make msg-group-o .msg:keys[] >back
    msg-group-o .msg:+lock
; is /lock
:noname ( addr u -- )
    2drop msg-group-o .msg:-lock
    [: net2o-base:msg-unlock ;] send-avalanche
; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?

:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
}scope