Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Try to make otrify work with encrypted messages — tricky, still doesn't work |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
30bcd87cd10a9c2c884c04d87369e108 |
User & Date: | bernd 2019-07-15 23:36:12 |
Context
2019-07-26
| ||
06:17 | Checkin from holiday check-in: 2ef7582d7f user: bernd tags: trunk | |
2019-07-15
| ||
23:36 | Try to make otrify work with encrypted messages — tricky, still doesn't work check-in: 30bcd87cd1 user: bernd tags: trunk | |
21:37 | Add chat permission settings check-in: 77cdb0b452 user: bernd tags: trunk | |
Changes
Changes to crypt.fs.
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 ... 577 578 579 580 581 582 583 584 585 586 587 588 589 590 ... 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 |
$100 uvar vaultkey \ buffers for vault $100 uvar keydump-buf \ buffer for dumping keys state2# uvar vkey \ maximum size for session key state2# uvar voutkey \ for keydump keysize uvar keygendh tf_ctx_256 uvar tf-key keysize uvar tf-out $10 uvar tf-hashout 1 64s uvar last-mykey cell uvar keytmp-up end-class keytmp-c user-o keybuf \ storage for secure permanent keys object uclass keybuf ................................................................................ dup 0= IF nip nip rdrop EXIT THEN swap .ke-sksig sec@ drop swap 2swap ed-quick-verify 0= sig-wrong and +sigquick THEN rdrop ; : date-sig? ( addr u pk -- addr u flag ) >r >date r> verify-sig ; : pk-sig? ( addr u -- addr u' flag ) dup sigpksize# u< IF sig-unsigned EXIT THEN 2dup sigpksize# - c:0key 2dup c:hash + date-sig? ; : pk-quick-sig? ( addr u -- addr u' flag ) dup sigpksize# u< IF sig-unsigned EXIT THEN ................................................................................ get1 get0 sct0 ge25519* dup get1 ge25519-pack $80 swap ( over ) $1F + xorc! ( keysize 85type forth:cr ) ; : decrypt-sig? ( key u msg u sig -- addr u sigerr ) { pksig } $make -5 { w^ msg err } msg $@ 2swap decrypt$ IF pksig sigpksize# over date-sig? to err 2drop err 0= IF pksig pktmp modkey> pksig sigpksize# keysize /string pktmp 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 2dup + 1- $80 swap orc! type keysize emit ; \\\ Local Variables: forth-local-words: ( (("event:") definition-starter (font-lock-keyword-face . 1) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("debug:" "field:" "2field:" "sffield:" "dffield:" "64field:" "uvar" "uvalue") non-immediate (font-lock-type-face . 2) |
> > > > < | | | < | | > > > > > |
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 ... 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 ... 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 |
$100 uvar vaultkey \ buffers for vault $100 uvar keydump-buf \ buffer for dumping keys state2# uvar vkey \ maximum size for session key state2# uvar voutkey \ for keydump 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 user-o keybuf \ storage for secure permanent keys object uclass keybuf ................................................................................ dup 0= IF nip nip rdrop EXIT THEN swap .ke-sksig sec@ drop swap 2swap ed-quick-verify 0= sig-wrong and +sigquick THEN 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 2dup sigpksize# - c:0key 2dup c:hash + date-sig? ; : pk-quick-sig? ( addr u -- addr u' flag ) dup sigpksize# u< IF sig-unsigned EXIT THEN ................................................................................ get1 get0 sct0 ge25519* dup get1 ge25519-pack $80 swap ( over ) $1F + xorc! ( keysize 85type forth:cr ) ; : 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 sigpksize# keysize /string 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-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: ( (("event:") definition-starter (font-lock-keyword-face . 1) "[ \t\n]" t name (font-lock-function-name-face . 3)) (("debug:" "field:" "2field:" "sffield:" "dffield:" "64field:" "uvar" "uvalue") non-immediate (font-lock-type-face . 2) |
Changes to gui.fs.
411
412
413
414
415
416
417
418
419
420
421
422
423
424
...
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
$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
................................................................................
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 }
{{
glue*l chain-color# slide-frame dup .button1
string sighash? IF re-green ELSE obj-red THEN
string [: ." <" drop le-64@ .ticks ;] $tmp }}text 25%b
}}z "chain" name! msg-box .child+
; wmsg-class is msg:chain
|
>
|
>
>
>
>
>
>
>
>
>
>
|
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
...
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
|
$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 $FFAA44FF text-color, fvalue perm-color# : nick[] ( box o:nick -- box ) [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ; Hash: avatar# glue new Constant glue*avatar ................................................................................ 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+ ; 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 string sighash? IF re-green ELSE obj-red THEN string [: ." <" drop le-64@ .ticks ;] $tmp }}text 25%b }}z "chain" name! msg-box .child+ ; wmsg-class is msg:chain |
Changes to msg.fs.
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 ... 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 ... 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 .... 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 .... 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 .... 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 |
<info> ." chat is locked" <default> ELSE 2drop <err> ." locked out of chat" <default> THEN ; msg-class is msg:lock :noname ( -- ) msg-group-o .msg:-lock <info> ." chat is free for all" <default> ; msg-class is msg:unlock ' drop msg-class is msg:away :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 ; msg-class is msg:perms :noname ( addr u type -- ) space <warn> case msg:image# of ." img[" 85type endof msg:thumbnail# of ." thumb[" 85type endof msg:patch# of ." patch[" 85type endof msg:snapshot# of ." snapshot[" 85type endof ................................................................................ :noname ( -- ) <info> [: ." nobody's online" msg-group-o .msg:?otr 0= IF ." , saving away" THEN ;] $tmp 2dup type <default> wait-2s-key xclear ; msg-class is msg:.nobody : 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 ; : new-otrsig ( addr u -- addrsig usig ) 2dup startdate@ old>otr c:0key sigpksize# - c:hash ['] .sig $tmp 1 64s /string ; :noname { sig u' addr u -- } u' 64'+ u = u sigsize# = and IF last# >r last# $@ >group addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r> 2dup = IF ." [otrified] " addr u startdate@ .ticks THEN U+DO I msg-group-o .msg:log[] $[]@ 2dup dup sigpksize# - /string key| msg:id$ str= IF dup u - /string addr u str= IF ." OTRify #" I u. sig u' I msg-group-o .msg:log[] $[]@ replace-sig save-msgs& ELSE ." [OTRified] #" I u. ................................................................................ net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest $> 2dup nest-sig ?dup-0=-IF handle-msg ELSE replay-mode @ IF drop 2drop 2drop 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 ( -- ) +zero16 nest$ 0 msg-group-o .msg:keys[] $[]@ encrypt$ ['] .encsign ']nestsig ; ................................................................................ [: last# >r o IF 2dup do-msg-nestsig ELSE 2dup display-one-msg THEN r> to last# 0 .avalanche-msg ;] [group] drop notify- ; \ chat message, text only : msg-tdisplay ( addr u -- ) 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 <default> ; ' msg-tdisplay msg-class is msg:display ' msg-tdisplay msg-notify-class is msg:display : ?search-lock ( addr u -- ) ................................................................................ ['] nick>chat arg-loop ; \ do otrify 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 keysize /string 2swap new-otrsig 2swap $, $, msg-otrify ELSE 2drop 2drop ." not your message!" forth:cr THEN THEN ; previous \ debugging aids for classes : .ack ( o:ack -- o:ack ) ." ack context:" cr ................................................................................ :noname ( addr u -- ) ['] logstyles evaluate-in ; is /logstyle :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 drop do-otrify 2r> REPEAT THEN 2drop 2r> 2drop ;] (send-avalanche) drop .chat save-msgs& ;] !wrapper ; is /otrify :noname ( addr u -- ) msg-group-o .msg:-lock |
| < | | > > > > > > > > > > > > > > > > > > > > > > > > < | > > > | > < < < < < < < < < < < < < < < < < < < < < | | > > > | | | | |
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 ... 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 ... 716 717 718 719 720 721 722 723 724 725 726 727 728 729 .... 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 .... 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 .... 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 |
<info> ." chat is locked" <default> ELSE 2drop <err> ." locked out of chat" <default> THEN ; msg-class is msg:lock :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 .perms space ; msg-class is msg:perms :noname ( addr u type -- ) space <warn> case msg:image# of ." img[" 85type endof msg:thumbnail# of ." thumb[" 85type endof msg:patch# of ." patch[" 85type endof msg:snapshot# of ." snapshot[" 85type endof ................................................................................ :noname ( -- ) <info> [: ." nobody's online" msg-group-o .msg:?otr 0= IF ." , saving away" THEN ;] $tmp 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 -- } addrsig usig addrmsg umsg usig - [: type type ;] $tmp 2dup msg-dec?-sig? !!sig!! 2drop addrmsg umsg smove ; : new-otrsig ( addr u -- addrsig usig ) 2dup startdate@ old>otr 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 last# >r last# $@ >group addr u startdate@ 64dup date>i >r 64#1 64+ date>i' r> 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. sig u' I msg-group-o .msg:log[] $[]@ replace-sig save-msgs& ELSE ." [OTRified] #" I u. ................................................................................ net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest $> 2dup nest-sig ?dup-0=-IF handle-msg ELSE replay-mode @ IF drop 2drop 2drop ELSE !!sig!! THEN \ balk on all wrong signatures THEN ; \ generate an encryt+sign packet : ]encpksign ( -- ) +zero16 nest$ 0 msg-group-o .msg:keys[] $[]@ encrypt$ ['] .encsign ']nestsig ; ................................................................................ [: last# >r o IF 2dup do-msg-nestsig ELSE 2dup display-one-msg THEN r> to last# 0 .avalanche-msg ;] [group] drop notify- ; \ chat message, text only : msg-tdisplay ( addr u -- ) 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 nest-cmd-loop msg:end <default> ; ' msg-tdisplay msg-class is msg:display ' msg-tdisplay msg-notify-class is msg:display : ?search-lock ( addr u -- ) ................................................................................ ['] nick>chat arg-loop ; \ do otrify also net2o-base : do-otrify ( n -- ) >r 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 ELSE drop THEN ; previous \ debugging aids for classes : .ack ( o:ack -- o:ack ) ." ack context:" cr ................................................................................ :noname ( addr u -- ) ['] logstyles evaluate-in ; is /logstyle :noname ( addr u -- ) msg-group-o .msg:mode dup @ msg:otr# or swap [: now>otr [: 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& ;] !wrapper ; is /otrify :noname ( addr u -- ) msg-group-o .msg:-lock |