Verified Commit 77003556 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Try to make otrify work with encrypted messages — tricky, still doesn't work

parent 16cd9cbb

crypt.fs

+14 −7
Original line number Diff line number Diff line
@@ -49,7 +49,9 @@ object uclass keytmp 
    keysize   uvar keygendh

    tf_ctx_256 uvar tf-key

    keysize   uvar tf-out

    keysize   uvar pkmod

    $10       uvar tf-hashout

    keccak#   uvar predate-key

    1 64s     uvar last-mykey

    cell      uvar keytmp-up

end-class keytmp-c
@@ -581,6 +583,7 @@ drop 
    rdrop ;



: date-sig? ( addr u pk -- addr u flag )

    c:key@ c:key# predate-key keccak# smove

    >r >date r> verify-sig ;

: pk-sig? ( addr u -- addr u' flag )

    dup sigpksize# u< IF  sig-unsigned  EXIT  THEN
@@ -694,25 +697,29 @@ drop 
: decrypt-sig? ( key u msg u sig -- addr u sigerr )

    { pksig } $make -5 { w^ msg err }

    msg $@ 2swap decrypt$ IF

	pksig pkmod modkey> \ key modification without date

	pksig sigpksize# over date-sig? to err  2drop

	err 0= IF

	    pksig pktmp modkey>

	    pksig sigpksize# keysize /string

	    pktmp keysize

	    pkmod keysize

	    2rot [: type type type ;] $tmp

	    2dup + 2 - $7F swap andc!

	    msg $free

	    err  EXIT  THEN  THEN

    2drop msg $free  0 0 err ;



: .encsign ( -- )

    +sig sigdate +date

    sktmp pktmp sk@ drop >modkey

    pktmp keysize type  sigdate datesize# type

    sig-params 2drop sktmp pktmp ed-sign

: .encsign-rest ( -- )

    sigdate +date

    sigdate datesize# type

    sig-params 2drop sktmp pkmod ed-sign

    2dup + 1- $80 swap orc! type

    keysize emit ;



: .encsign ( -- )

    +sig

    sktmp pkmod sk@ drop >modkey

    pkmod keysize type .encsign-rest ;



\\\

Local Variables:

forth-local-words:

gui.fs

+12 −1
Original line number Diff line number Diff line
@@ -415,6 +415,7 @@ $000077FF new-color, fvalue chain-color# 
$FF000000 $FF0000FF fade-color: show-error-color

$338833FF text-color: lock-color

$883333FF text-color: lockout-color

$FFAA44FF text-color, fvalue perm-color#



: nick[] ( box o:nick -- box )

    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;
@@ -913,13 +914,23 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \ 
	{{

	    glue*l lock-color x-color slide-frame dup .button1

	    blackish l" chat is unlocked" }}text' 25%bv

	}}z msg-box .child+ ;

	}}z msg-box .child+ ; wmsg-class is msg:unlock

: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 { 64^ perm d: pk -- }

    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!

    {{

	glue*l perm-color# slide-frame dup .button1

	{{

	    pk [: '@' emit .key-id ;] $tmp ['] utf8-sanitize $tmp }}text 25%b

	    perm 64@ 64>n ['] .perms $tmp }}text 25%b

	}}h

    }}z msg-box .child+

; wmsg-class is msg:perms

:noname { d: string -- o }

    {{

	glue*l chain-color# slide-frame dup .button1

msg.fs

+41 −33
Original line number Diff line number Diff line
@@ -467,11 +467,13 @@ scope: logstyles 
:noname ( -- )  msg-group-o .msg:-lock

    <info> ." chat is free for all" <default> ; msg-class is msg:unlock

' drop msg-class is msg:away

: .perms ( n -- )

    "👹" bounds U+DO

	dup 1 and IF  I xc@ xemit  THEN  2/

    I I' over - x-size  +LOOP  drop ;

:noname { 64^ perm d: pk -- }

    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!

    pk .key-id ." : " perm 64@ 64>n s" 👹" bounds U+DO

	dup 1 and IF  I xc@ xemit  THEN  2/

    I I' over - x-size  +LOOP  drop space

    pk .key-id ." : " perm 64@ 64>n .perms space

; msg-class is msg:perms

:noname ( addr u type -- )

    space <warn> case
@@ -504,13 +506,36 @@ msg-class is msg:object 
    2dup type <default>

    wait-2s-key xclear ; msg-class is msg:.nobody



\ encrypt+sign

\ features: signature verification only when key is known

\           identity only revealed when correctly decrypted



: msg-dec-sig? ( addr u -- addr' u' flag )

    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-sig? ( addr u -- addr u' flag )

    skip-sig? @ IF   quicksig( pk-quick-sig? )else( pk-date? )

    ELSE  pk-sig?  THEN ;



: msg-dec?-sig? ( addr u -- addr' u' flag )

    2dup 2 - + c@ $80 and IF  msg-dec-sig?  ELSE  msg-sig?  THEN ;



: replace-sig { addrsig usig addrmsg umsg -- }

    \ !!dummy!! need to verify signature!

    addrsig usig addrmsg umsg usig - [: type type ;] $tmp

    2dup pk-sig? !!sig!! 2drop addrmsg umsg smove ;

    2dup msg-dec?-sig? !!sig!! 2drop addrmsg umsg smove ;

: new-otrsig ( addr u -- addrsig usig )

    2dup startdate@ old>otr

    c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ;

    predate-key keccak# c:key@ c:key# smove

    + 2 - c@ $80 and >r

    ['] .encsign-rest ['] .sig r> select

    $tmp 1 64s /string ;



:noname { sig u' addr u -- }

    u' 64'+ u =  u sigsize# = and IF
@@ -519,6 +544,7 @@ msg-class is msg:object 
	2dup = IF  ."  [otrified] "  addr u startdate@ .ticks  THEN

	U+DO

	    I msg-group-o .msg:log[] $[]@

	    2dup + 2 - c@ $80 and IF  msg-dec-sig? drop  THEN

	    2dup dup sigpksize# - /string key| msg:id$ str= IF

		dup u - /string addr u str= IF

		    ."  OTRify #" I u.
@@ -694,27 +720,6 @@ net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest 
	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 ;



\ encrypt+sign

\ features: signature verification only when key is known

\           identity only revealed when correctly decrypted



: msg-dec-sig? ( addr u -- addr' u' flag )

    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 ( -- )
@@ -1007,7 +1012,7 @@ previous 
\ chat message, text only



: msg-tdisplay ( addr u -- )

    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? IF

    2dup 2 - + c@ $80 and IF  msg-dec-sig? IF

	    2drop <err> ." Undecryptable message" <default> cr  EXIT

	THEN  <info>  THEN

    sigpksize# - 2dup + sigpksize# >$  c-state off
@@ -1206,15 +1211,18 @@ Variable chat-keys 
also net2o-base



: do-otrify ( n -- ) >r

    msg-group$ $@ >group msg-group-o .msg:log[] $@ r> cells safe/string

    IF  $@ 2dup + sigpksize# - sigpksize#

	over keysize pkc over str= IF

    msg-group$ $@ >group msg-group-o .msg:log[] $@

    r> cells dup 0< IF  over + 0 max  THEN safe/string

    IF  $@

	2dup + 2 - c@ $80 and IF  msg-dec-sig? drop  THEN

	2dup + sigpksize# - sigpksize#

	over keysize pk@ key| str= IF

	    keysize /string 2swap new-otrsig 2swap

	    $, $, msg-otrify

	ELSE

	    2drop 2drop ." not your message!" forth:cr

	THEN

    THEN ;

    ELSE  drop  THEN ;



previous
@@ -1491,7 +1499,7 @@ is /help 
:noname ( addr u -- )

    msg-group-o .msg:mode dup @ msg:otr# or swap

    [: now>otr

	[: BEGIN  bl $split 2>r dup  WHILE  s>unumber? WHILE

	[: BEGIN  bl $split 2>r dup  WHILE  s>number? WHILE

			drop do-otrify  2r>  REPEAT THEN

	    2drop 2r> 2drop

	;] (send-avalanche) drop .chat save-msgs&