Commit 77003556 authored by Bernd Paysan's avatar Bernd Paysan

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

parent 16cd9cbb
......@@ -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:
......
......@@ -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
......
......@@ -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&
......
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