Lock/unlock of chat looks good now

parent 10841a0c
......@@ -264,6 +264,7 @@ Sema id-sema
+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
......
......@@ -413,6 +413,8 @@ $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[] ;
......@@ -894,6 +896,24 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \
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
......@@ -999,8 +1019,9 @@ wmsg-o >o msg-table @ token-table ! o>
msgs-box .dispose-childs
glue*lll }}glue msgs-box .child+
2dup load-msg
msg-log@ 2dup { log u }
dup gui-msgs# cells - 0 max /string bounds ?DO
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
......
......@@ -299,8 +299,7 @@ in net2o : pklookup? ( pkaddr u -- flag )
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
lastaddr# IF lastaddr# cell+ $@ dest-0key sec! THEN ;
false id dup .dht-host ['] insert-host? $[]map drop nip nip ;
in net2o : pklookup ( pkaddr u -- )
net2o:pklookup? 0= !!no-address!! ;
......
......@@ -1297,6 +1297,7 @@ also net2o-base
[: 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
......
......@@ -13,6 +13,9 @@ Meine Schlüssel
Meine Gruppen
Meine Freunde
Posting
Niemand ist online, speichere weg
......
......@@ -13,7 +13,10 @@ My key
My groups
My peers
Post
Nobody is online, saving away
Nobody is online
Invitations
......@@ -13,6 +13,9 @@ net2o 图形用户界面
我的集团
我的朋友
贴子
没有人在线,保存了
发送
......
......@@ -702,7 +702,7 @@ net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
>r 2nip r> unloop EXIT
THEN drop 2drop
cell +LOOP
sigpksize# + -5 replay-mode @ 0= and ;
sigpksize# + -5 ;
: msg-dec?-sig? ( addr u -- addr' u' flag )
2dup 2 - + c@ $80 and IF msg-dec-sig? ELSE msg-sig? THEN ;
......@@ -716,11 +716,10 @@ net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
\ nest-sig for msg/msging classes
' msg-dec?-sig? ' message 2dup
msging-class is start-req
msging-class is nest-sig
msg-class is start-req
msg-class is nest-sig
' 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
......@@ -918,7 +917,7 @@ event: :>msg-eval ( parent $pack $addr -- )
: msg> ( -- )
\G end a message block by adding a signature
msg-group-o .msg:?lock IF ]encpksign ELSE ]pksign THEN ;
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> ;
......@@ -1007,11 +1006,18 @@ previous
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@ 2dup { log u }
dup r> - 0 max /string bounds ?DO
[: 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
......@@ -1488,7 +1494,9 @@ is /help
msg-group-o .msg:+lock
; is /lock
:noname ( addr u -- )
2drop msg-group-o .msg:-lock ; is /unlock
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?
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment