Verified Commit 7d322a2c authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Lock/unlock of chat looks good now

parent 10841a0c

connect.fs

+1 −0
Original line number Diff line number Diff line
@@ -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

gui.fs

+23 −2
Original line number Diff line number Diff line
@@ -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

helper.fs

+1 −2
Original line number Diff line number Diff line
@@ -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!! ;

keys.fs

+1 −0
Original line number Diff line number Diff line
@@ -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

lang/de

+3 −0
Original line number Diff line number Diff line
@@ -13,6 +13,9 @@ Meine Schlüssel 
Meine Gruppen

Meine Freunde

Posting









Niemand ist online, speichere weg