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.275 |
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 | $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 | > > | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | $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 |
︙ | ︙ | |||
577 578 579 580 581 582 583 584 585 586 587 588 589 590 | 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 | > | 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 | 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 |
︙ | ︙ | |||
690 691 692 693 694 695 696 697 698 | 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 | > < | | | < | | > > > > > | 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 | 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 | $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 | > | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 | $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 |
︙ | ︙ | |||
909 910 911 912 913 914 915 | 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 | | > > > > > > > > > > | 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 | 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 | <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# #! | > > > > | < < | 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 | <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 |
︙ | ︙ | |||
500 501 502 503 504 505 506 507 | :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 -- } | > > > > > > > > > > > > > > > > > > > > > < | > > > | > | 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 | :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. |
︙ | ︙ | |||
690 691 692 693 694 695 696 | 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 ; | < < < < < < < < < < < < < < < < < < < < < | 716 717 718 719 720 721 722 723 724 725 726 727 728 729 | 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 ; |
︙ | ︙ | |||
1003 1004 1005 1006 1007 1008 1009 | [: 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 -- ) | | | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 | [: 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 -- ) |
︙ | ︙ | |||
1202 1203 1204 1205 1206 1207 1208 | ['] nick>chat arg-loop ; \ do otrify also net2o-base : do-otrify ( n -- ) >r | | > > > | | | | 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 | ['] 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 |
︙ | ︙ | |||
1487 1488 1489 1490 1491 1492 1493 | :noname ( addr u -- ) ['] logstyles evaluate-in ; is /logstyle :noname ( addr u -- ) msg-group-o .msg:mode dup @ msg:otr# or swap [: now>otr | | | 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 | :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 |
︙ | ︙ |