Check-in [38e2425029]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Get keys from peers
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 38e2425029c6070e59671dc4d96f03e9af9b203c
User & Date: bernd 2020-01-31 19:35:09
Context
2020-01-31
21:58
Fix key import through chat check-in: 8f5ba435cf user: bernd tags: trunk
19:35
Get keys from peers check-in: 38e2425029 user: bernd tags: trunk
2020-01-30
12:35
Bump version number check-in: a6fdb1eb15 user: bernd tags: trunk, 0.9.7-20200130
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to classes.fs.

141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    $value: id$   \ id of current message
    $value: msg$  \ decrypted message
    64value: timestamp \ timestamp of message
    field: peers[]
    field: keys[]
    field: log[]
    field: hashs[]
    field: pks[]
    field: perms# \ pk -> permission map
    field: mode
    \ mode bits:
    1 3 bits: otr# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}







|







141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    $value: id$   \ id of current message
    $value: msg$  \ decrypted message
    64value: timestamp \ timestamp of message
    field: peers[]
    field: keys[]
    field: log[]
    field: hashs[]
    field: pks#
    field: perms# \ pk -> permission map
    field: mode
    \ mode bits:
    1 3 bits: otr# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}

Changes to msg.fs.

197
198
199
200
201
202
203

204
205
206
207

208
209
210
211
212
213
214
....
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283









1284
1285
1286
1287

1288

1289
1290







1291
1292
1293
1294




1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
....
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999

: display-one-msg { d: msgt -- }
    msg-group-o >o
    msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
    o> ;

Forward silent-join


\ !!FIXME!! should use an asynchronous "do-when-connected" thing

: +unique-con ( -- ) o msg-group-o .msg:peers[] +unique$ ;

Forward +chat-control

: chat-silent-join ( -- )
    reconnect( ." silent join " o hex. connection hex. cr )
    o to connection
    ?msg-context >o silent-last# @ to last# o>
    reconnect( ." join: " last# $. cr )
................................................................................
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN
    REPEAT  2drop ;
: ?scan-pks ( addr u -- )
    bounds U+DO
	I $@ sigpk2size# - + keysize 2dup key# #@ d0= IF
	    msg-group-o .msg:pks[] $ins[] drop
	THEN
    cell +LOOP ;









: fetch-pks ( -- )
    msg-group-o .msg:pks[] $@len 0<>
    msg-group-o .msg:peers[] $@len 0<> and IF
	0 msg-group-o .msg:peers[] $[] @ >o o to connection

	0 msg-group-o .msg:pks[] $@ bounds U+DO

	    dup 0= IF  1+  net2o-code  expect-reply  THEN
	    I $@ $, dht-id dht-owner? end-with







	    dup 4 = IF  cookie+request end-code| drop 0  THEN
	cell +LOOP o>
	msg-group-o .msg:pks[] $[]free
    THEN ;




: msg-tredisplay ( n -- )
    reset-time
    msg-group-o >o msg:?otr msg:-otr o> >r
    [: cells >r msg-log@
      { log u } log u ?scan-pks fetch-pks
      u r> - 0 max { u' }  log u' ?search-lock
      log u u' /string bounds ?DO
	  I log - cell/ to log#
	  I $@ { d: msgt }
	  msgt ['] msg:display catch IF  ." invalid entry" cr
	      2drop  THEN
      cell +LOOP
      log free throw ;] catch
................................................................................
: +chat-control ( -- )
    +resend-msg +flow-control ;

: chat#-connect? ( addr u buf1 buf2 --- flag )
    pk-connect-dests? dup IF  connection >o rdrop +chat-control  +group  THEN ;

: chat-connect ( addr u -- )
    chat-bufs# chat#-connect? IF  greet  THEN ;

: key-ctrlbit ( -- n )
    \G return a bit mask for the control key pressed
    1 key dup bl < >r lshift r> and ;

: wait-key ( -- )
    BEGIN  key-ctrlbit [ 1 ctrl L lshift 1 ctrl Z lshift or ]L







>




>







 







|
|
|

>
>
>
>
>
>
>
>
>
|
|
<
|
>
|
>
|
|
>
>
>
>
>
>
>
|
<
|

>
>
>
>



|
|
|







 







|







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
....
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296

1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310

1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
....
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021

: display-one-msg { d: msgt -- }
    msg-group-o >o
    msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
    o> ;

Forward silent-join
Forward fetch-pks

\ !!FIXME!! should use an asynchronous "do-when-connected" thing

: +unique-con ( -- ) o msg-group-o .msg:peers[] +unique$ ;

Forward +chat-control

: chat-silent-join ( -- )
    reconnect( ." silent join " o hex. connection hex. cr )
    o to connection
    ?msg-context >o silent-last# @ to last# o>
    reconnect( ." join: " last# $. cr )
................................................................................
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN
    REPEAT  2drop ;
: ?scan-pks ( addr u -- )
    bounds U+DO
	I $@ sigpksize# - + keysize 2dup key# #@ d0= IF
	    "key" 2swap msg-group-o .msg:pks# #!
	ELSE  2drop  THEN
    cell +LOOP ;
: free-obtained-pks ( addr -- )
    [: $@ >d#id >o dht-owner $[]# 0> IF
	    last# $free  last# cell+ $free
	    import#chat import-type !
	    64#-1 key-read-offset 64!
	    [: 0 dht-owner $[]@ 2dup sigsize# - forth:type
		dht-hash $. dup sigsize# - safe/string forth:type ;] $tmp
	    ['] read-pk2key$ catch IF  2drop  THEN
	ELSE  1+  THEN o> ;] #map ;
: fetch-pks ( o:peer-con -- )
    0 msg-group-o .msg:pks# [: drop 1+ ;] #map 0<>  IF

	o to connection
	0 0 { start requests }
	msg-group-o .msg:pks#
	addr start addr requests [{: start requests :}l
	    start @ 0= IF  net2o-code  expect-reply  THEN
	    $@ $, dht-id dht-owner? end-with
	    start @ 3 u< IF
		1 start +!
	    ELSE
		start off  1 requests +!  cookie+request
		requests @ $10 > IF  end-code|  0 to requests
		ELSE  [ also net2o-base ]   end-code|  THEN
	    THEN ;] #map
	start IF  [ also net2o-base ] cookie+request end-code|  THEN

	msg-group-o .msg:pks# free-obtained-pks
    THEN ;
: ?fetch-pks
    msg-group-o >o msg:peers[] $[]# 0 ?DO
	I msg:peers[] $[] @ .fetch-pks
    LOOP o> ;
: msg-tredisplay ( n -- )
    reset-time
    msg-group-o >o msg:?otr msg:-otr o> >r
    [: cells >r msg-log@ { log u } u r> - 0 max { u' }
      log u u' /string ?scan-pks  ?fetch-pks
      log u' ?search-lock
      log u u' /string bounds ?DO
	  I log - cell/ to log#
	  I $@ { d: msgt }
	  msgt ['] msg:display catch IF  ." invalid entry" cr
	      2drop  THEN
      cell +LOOP
      log free throw ;] catch
................................................................................
: +chat-control ( -- )
    +resend-msg +flow-control ;

: chat#-connect? ( addr u buf1 buf2 --- flag )
    pk-connect-dests? dup IF  connection >o rdrop +chat-control  +group  THEN ;

: chat-connect ( addr u -- )
    chat-bufs# chat#-connect? IF  greet fetch-pks  THEN ;

: key-ctrlbit ( -- n )
    \G return a bit mask for the control key pressed
    1 key dup bl < >r lshift r> and ;

: wait-key ( -- )
    BEGIN  key-ctrlbit [ 1 ctrl L lshift 1 ctrl Z lshift or ]L