Check-in [98c8738196]
Not logged in

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

Overview
Comment:Bump version number
Timelines: family | ancestors | descendants | both | trunk | 0.7.2-20180607
Files: files | file ages | folders
SHA1: 98c8738196d691f243e32ab514f8d7db8997076c
User & Date: bernd 2018-06-07 14:02:58
Context
2018-06-07
15:39
Bump gforth version in do check-in: 41bfd871b7 user: bernd tags: trunk
14:02
Bump version number check-in: 98c8738196 user: bernd tags: trunk, 0.7.2-20180607
2018-06-01
22:42
Back button from chat log check-in: c2dbb9ae4a user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to configure.ac.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.

# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

AC_INIT([net2o], [0.7.1-20180531], [bernd@net2o.de], [net2o], [https://fossil.net2o.de/net2o/reportlist])
AC_PREREQ([2.59])
AC_CONFIG_MACRO_DIR([m4])
AC_USE_SYSTEM_EXTENSIONS
LT_INIT

AC_MSG_CHECKING([for gforth])








|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Affero General Public License for more details.

# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

AC_INIT([net2o], [0.7.2-20180607], [bernd@net2o.de], [net2o], [https://fossil.net2o.de/net2o/reportlist])
AC_PREREQ([2.59])
AC_CONFIG_MACRO_DIR([m4])
AC_USE_SYSTEM_EXTENSIONS
LT_INIT

AC_MSG_CHECKING([for gforth])

Changes to gui.fs.

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
188
189
190
191
192
193
194

195
196
197
198
199
200
201
...
251
252
253
254
255
256
257





258
259
260
261

262

263
264
265
266
267
268
269
270
271
...
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
...
466
467
468
469
470
471
472


473
474
475
476
477
478
479
	1 tries# +! tries# @ 0 <# #s #> pw-num >o to text$ o>
	keys sec[]free
	drop nip 0 tuck false
	1e o ['] shake-lr >animate
	1 tries# @ lshift s>f f2/ pw-err ['] err-fade >animate
    ELSE
	0 >o 0 secret-key init-client >raw-key
	read-chatgroups o>
	\ ." Right passphrase" cr
	show-nicks
	true
    THEN ;

: 20%bt ( o -- o ) >o font-size# 20% f* to bordert o o> ;
: 25%b ( o -- o ) >o font-size# 25% f* to border o o> ;
................................................................................
0 Value groups-box
0 Value nicks-box
0 Value msgs-box
0 Value msg-box
0 Value msg-vbox

0 Value group-name


htab-glue new tab-glue: name-tab
htab-glue new tab-glue: pk-tab
htab-glue new tab-glue: group-tab
htab-glue new tab-glue: chatname-tab

[IFUNDEF] child+
................................................................................
	I @ .show-nick
    cell +LOOP ;

: refresh-top ( -- )
    +sync +lang
    top-widget >o htop-resize  <draw-init draw-init draw-init> htop-resize o> ;






: group[] ( box group -- box )
    [:  top-widget >r
	data $@ group-name >o to text$ o>
	data cell+ $@ drop cell+ .groups:id$

	gui-msgs chat-frame to top-widget refresh-top

	widgets-loop
	r> to top-widget +sync
    ;] swap click[] ;

: show-group ( last# -- )
    dup { g -- } cell+ $@ drop cell+ >o
    {{ glue*l $CCAA44FF slide-frame dup .button1
	{{
	    {{ \large blackish
................................................................................

wmsg-class ' new static-a with-allocater Constant wmsg-o
wmsg-o >o msg-table @ token-table ! o>

: wmsg-display ( addr u -- )
    !date wmsg-o .msg-display ;

#512 Value gui-msgs# \ display last 300 messages

: gui-msgs ( gaddr u -- )
    -1 to last-day
    -1 to last-hour
    -1 to last-minute
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+
................................................................................
	{{
	    glue*l $000000FF slide-frame dup .button1
	    {{
		\large whitish
		"⬅" }}text 40%b [: -1 level# +! ;] over click[]
		!i18n l" Chat Log" }}text' !lit 40%b
		"" }}text 40%b dup to group-name


		glue*l }}glue
	    }}h box[]
	}}z box[]
	{{
	    {{
		{{
		tex: vp-chats vp-chats glue*lll ' vp-chats }}vp vp[]







|







 







>







 







>
>
>
>
>



|
>

>
|
|







 







|







 







>
>







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
...
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
...
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
	1 tries# +! tries# @ 0 <# #s #> pw-num >o to text$ o>
	keys sec[]free
	drop nip 0 tuck false
	1e o ['] shake-lr >animate
	1 tries# @ lshift s>f f2/ pw-err ['] err-fade >animate
    ELSE
	0 >o 0 secret-key init-client >raw-key
	read-chatgroups announce-me o>
	\ ." Right passphrase" cr
	show-nicks
	true
    THEN ;

: 20%bt ( o -- o ) >o font-size# 20% f* to bordert o o> ;
: 25%b ( o -- o ) >o font-size# 25% f* to border o o> ;
................................................................................
0 Value groups-box
0 Value nicks-box
0 Value msgs-box
0 Value msg-box
0 Value msg-vbox

0 Value group-name
0 Value group-members

htab-glue new tab-glue: name-tab
htab-glue new tab-glue: pk-tab
htab-glue new tab-glue: group-tab
htab-glue new tab-glue: chatname-tab

[IFUNDEF] child+
................................................................................
	I @ .show-nick
    cell +LOOP ;

: refresh-top ( -- )
    +sync +lang
    top-widget >o htop-resize  <draw-init draw-init draw-init> htop-resize o> ;

: gui-chat-connects ( -- )
    chat-keys [: key>group
	2dup search-connect ?dup-IF  >o +group greet o> 2drop  EXIT  THEN
	2dup pk-peek? IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;

: group[] ( box group -- box )
    [:  top-widget >r
	data $@ group-name >o to text$ o>
	data cell+ $@ drop cell+ >o groups:id$ groups:member[] o>
	[: [: 2over type '@' emit type ;] $tmp chat-keys $+[]! ;] $[]map
	gui-msgs chat-frame to top-widget refresh-top
	gui-chat-connects
	widgets-loop \ connection .send-leave
	r> to top-widget +sync +config
    ;] swap click[] ;

: show-group ( last# -- )
    dup { g -- } cell+ $@ drop cell+ >o
    {{ glue*l $CCAA44FF slide-frame dup .button1
	{{
	    {{ \large blackish
................................................................................

wmsg-class ' new static-a with-allocater Constant wmsg-o
wmsg-o >o msg-table @ token-table ! o>

: wmsg-display ( addr u -- )
    !date wmsg-o .msg-display ;

#128 Value gui-msgs# \ display last 128 messages

: gui-msgs ( gaddr u -- )
    -1 to last-day
    -1 to last-hour
    -1 to last-minute
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+
................................................................................
	{{
	    glue*l $000000FF slide-frame dup .button1
	    {{
		\large whitish
		"⬅" }}text 40%b [: -1 level# +! ;] over click[]
		!i18n l" Chat Log" }}text' !lit 40%b
		"" }}text 40%b dup to group-name
		{{
		}}h box[] dup to group-members
		glue*l }}glue
	    }}h box[]
	}}z box[]
	{{
	    {{
		{{
		tex: vp-chats vp-chats glue*lll ' vp-chats }}vp vp[]

Changes to helper.fs.

61
62
63
64
65
66
67







68

69


70

71
72
73
74
75
76
77
78
79
80
81
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
...
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244





245
246
247
248
249
250
251
...
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
...
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
    connect( [: .time ." Connect to: " dup hex. cr ;] $err )
    net2o:new-context >o rdrop o to connection  setup!
    dest-pk \ set our destination key
    +resend-cmd net2o:connect
    +flow-control +resend
    connect( [: .time ." Connected, o=" o hex. cr ;] $err ) ;








: dht-connect' ( xt -- ) >r

    $8 $8 dhtnick $@ nick>pk dhtroot r> execute pk:connect ;


: dht-connect ( -- )  ['] noop dht-connect' ;


Variable announced
: subme ( -- )  announced @ IF
	dht-connect sub-me disconnect-me  THEN ;

: c:disconnect ( -- ) connect( [: ." Disconnecting..." cr ;] $err )
    disconnect-me connect( [: .packets profile( .times ) ;] $err ) ;

: c:fetch-id ( pubkey u -- )
    net2o-code
      expect-reply  fetch-id,
................................................................................
      cell +LOOP
    ;] #map ;

\ notification for address changes

true Value connected?

Forward dht-beacon
Forward renat-all

[IFDEF] android     require android/net.fs  [ELSE]
    [IFDEF] PF_NETLINK  require linux/net.fs    [THEN]
[THEN]

\ announce and renat

event: :>renat ( -- )  renat-all ;
: dht-beacon <event :>renat main-up@ event> 2drop ;

: announce-me ( -- )
    tick-adjust 64@ 64-0= IF  +get-time  THEN
    beacons @ IF  dht-connect
    ELSE  [: return-addr be@ ['] dht-beacon 0 .add-beacon ;] dht-connect'
    THEN
    replace-me disconnect-me -other  announced on ;

: renat-all ( -- ) beacon( ." remove all beacons" cr )
    [IFDEF] renat-complete [: [THEN]
    beacons #offs !my-addr announce-me renat
    [IFDEF] renat-complete ;] catch renat-complete throw [THEN]
    beacon( ." done renat" cr ) ;

................................................................................
	2dup d0<> WHILE
	    over c@ '!' = WHILE
		replace-key o>
		connect( >o ke-pk $@ ." replace key: " 2dup 85type cr o o> )
		>r 2dup c:fetch-id r> >o  REPEAT  THEN  d0<> ;

: pk-query ( addr u xt -- flag ) >r
    dht-connect  2dup r> execute  replace-loop  disconnect-me ;

: pk-lookup ( addr u -- )
    ['] pk:fetch-host  ['] pk:addme-fetch-host  announced @ select
    pk-query 0= !!host-notfound!! ;

: pk-peek? ( pk u -- flag )  ['] pk:fetch-host pk-query ;

User hostc$ \ check for this hostname

: check-host? ( o addr u -- o addr' u flag )
    2 pick .host>$ ;






: host= ( o -- flag )
    >o hostc$ $@ dup IF  host:id $@ str=  ELSE  2drop true  THEN  o> ;

: insert-addr ( o -- flag )
    connect( ." check addr: " dup .addr cr )  false swap
    [: check-addr1 0= IF  2drop EXIT  THEN
      insert-address temp-addr ins-dest
................................................................................
	  temp-addr ret-addr $10 move
      THEN  !0key  drop true ;] addr>sock ;

: insert-addr$ ( addr u -- flag )  dest-0key dest-0key> !
    new-addr dup insert-addr swap .net2o:dispose-addr ;

: insert-host ( addr u -- flag )  dest-0key dest-0key> !
    new-addr  dup host=  IF
	msg( ." insert: " dup .host:id $@ type cr )
	dup insert-addr  ELSE  false  THEN
    swap .net2o:dispose-addr ;

: insert-host? ( flag o addr u -- flag' o )
    3 pick IF  2drop  EXIT  THEN
    check-host? IF  insert-host  ELSE  2drop false  THEN
    rot or swap ;

: make-context ( pk u -- )
    ret0 net2o:new-context >o rdrop dest-pk ;

in net2o : pklookup ( pkaddr u -- )
    2dup keysize2 safe/string hostc$ $! key2|
    2dup >d#id { id }
    id .dht-host $[]# 0= IF  2dup pk-lookup  2dup >d#id to id  THEN
    2dup make-context
    false id dup .dht-host ['] insert-host? $[]map drop
    0= !!no-address!!  2drop ;

: ?nat-done ( n -- )
................................................................................
User search-key[]
User pings[]

: search-keys ( -- )
    dht-connect
    net2o-code  expect-reply
    search-key[] [: $, dht-id dht-owner? end-with ;] $[]map
    cookie+request end-code| disconnect-me ;

: search-addrs ( -- )
    dht-connect
    net2o-code  expect-reply
    search-key[] [: $, dht-id dht-host? end-with ;] $[]map
    cookie+request end-code| disconnect-me ;

: insert-keys ( -- )
    defaultkey @ >storekey !
    import#dht import-type !
    search-key[] [: >d#id >o
      0 dht-owner $[]@ nip sigsize# u> IF
	  64#-1 key-read-offset 64!







>
>
>
>
>
>
>
|
>
|
>
>
|
>



|







 







<
<
<






<
<
<


<
<
<
|







 







|












>
>
>
>
>







 







|













|







 







|





|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
...
124
125
126
127
128
129
130



131
132
133
134
135
136



137
138



139
140
141
142
143
144
145
146
...
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
    connect( [: .time ." Connect to: " dup hex. cr ;] $err )
    net2o:new-context >o rdrop o to connection  setup!
    dest-pk \ set our destination key
    +resend-cmd net2o:connect
    +flow-control +resend
    connect( [: .time ." Connected, o=" o hex. cr ;] $err ) ;

0 Value dht-connection

Forward renat-all

event: :>renat ( -- )  renat-all ;
: dht-beacon <event :>renat main-up@ event> 2drop ;

: dht-connect ( -- )
    dht-connection ?dup-IF  >o o to connection rdrop  EXIT  THEN
    $8 $8 dhtnick $@ nick>pk dhtroot
    beacons @ 0= IF  return-addr be@ ['] dht-beacon 0 .add-beacon  THEN
    pk:connect  o to dht-connection ;
: dht-disconnect ( -- )
    0 addr dht-connection !@  ?dup-IF  .disconnect-me  THEN ;

Variable announced
: subme ( -- )  announced @ IF
	dht-connect sub-me THEN ;

: c:disconnect ( -- ) connect( [: ." Disconnecting..." cr ;] $err )
    disconnect-me connect( [: .packets profile( .times ) ;] $err ) ;

: c:fetch-id ( pubkey u -- )
    net2o-code
      expect-reply  fetch-id,
................................................................................
      cell +LOOP
    ;] #map ;

\ notification for address changes

true Value connected?




[IFDEF] android     require android/net.fs  [ELSE]
    [IFDEF] PF_NETLINK  require linux/net.fs    [THEN]
[THEN]

\ announce and renat




: announce-me ( -- )
    tick-adjust 64@ 64-0= IF  +get-time  THEN



    dht-connect replace-me -other  announced on ;

: renat-all ( -- ) beacon( ." remove all beacons" cr )
    [IFDEF] renat-complete [: [THEN]
    beacons #offs !my-addr announce-me renat
    [IFDEF] renat-complete ;] catch renat-complete throw [THEN]
    beacon( ." done renat" cr ) ;

................................................................................
	2dup d0<> WHILE
	    over c@ '!' = WHILE
		replace-key o>
		connect( >o ke-pk $@ ." replace key: " 2dup 85type cr o o> )
		>r 2dup c:fetch-id r> >o  REPEAT  THEN  d0<> ;

: pk-query ( addr u xt -- flag ) >r
    dht-connect  2dup r> execute  replace-loop ;

: pk-lookup ( addr u -- )
    ['] pk:fetch-host  ['] pk:addme-fetch-host  announced @ select
    pk-query 0= !!host-notfound!! ;

: pk-peek? ( pk u -- flag )  ['] pk:fetch-host pk-query ;

User hostc$ \ check for this hostname

: check-host? ( o addr u -- o addr' u flag )
    2 pick .host>$ ;

0 Value ?myself

: myhost= ( o -- flag )
    .host:id $@ host$ $@ str= ?myself and ;
    
: host= ( o -- flag )
    >o hostc$ $@ dup IF  host:id $@ str=  ELSE  2drop true  THEN  o> ;

: insert-addr ( o -- flag )
    connect( ." check addr: " dup .addr cr )  false swap
    [: check-addr1 0= IF  2drop EXIT  THEN
      insert-address temp-addr ins-dest
................................................................................
	  temp-addr ret-addr $10 move
      THEN  !0key  drop true ;] addr>sock ;

: insert-addr$ ( addr u -- flag )  dest-0key dest-0key> !
    new-addr dup insert-addr swap .net2o:dispose-addr ;

: insert-host ( addr u -- flag )  dest-0key dest-0key> !
    new-addr  dup host=  over myhost= 0= and  IF
	msg( ." insert: " dup .host:id $@ type cr )
	dup insert-addr  ELSE  false  THEN
    swap .net2o:dispose-addr ;

: insert-host? ( flag o addr u -- flag' o )
    3 pick IF  2drop  EXIT  THEN
    check-host? IF  insert-host  ELSE  2drop false  THEN
    rot or swap ;

: make-context ( pk u -- )
    ret0 net2o:new-context >o rdrop dest-pk ;

in net2o : pklookup ( pkaddr u -- )
    2dup keysize2 safe/string hostc$ $! key2| 2dup pkc over str= to ?myself
    2dup >d#id { id }
    id .dht-host $[]# 0= IF  2dup pk-lookup  2dup >d#id to id  THEN
    2dup make-context
    false id dup .dht-host ['] insert-host? $[]map drop
    0= !!no-address!!  2drop ;

: ?nat-done ( n -- )
................................................................................
User search-key[]
User pings[]

: search-keys ( -- )
    dht-connect
    net2o-code  expect-reply
    search-key[] [: $, dht-id dht-owner? end-with ;] $[]map
    cookie+request end-code| ;

: search-addrs ( -- )
    dht-connect
    net2o-code  expect-reply
    search-key[] [: $, dht-id dht-host? end-with ;] $[]map
    cookie+request end-code| ;

: insert-keys ( -- )
    defaultkey @ >storekey !
    import#dht import-type !
    search-key[] [: >d#id >o
      0 dht-owner $[]@ nip sigsize# u> IF
	  64#-1 key-read-offset 64!

Changes to n2o.fs.

683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
    ?get-me ['] hash-out arg-loop ;

\ others

: bye ( -- )
    \U bye
    \G bye: quit command mode and terminate program
    subme bye ;

: -bw ( -- )
    \O -bw
    \G -bw: disable color codes
    ['] drop is attr!  next-cmd ;

: -yes ( -- )







|







683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
    ?get-me ['] hash-out arg-loop ;

\ others

: bye ( -- )
    \U bye
    \G bye: quit command mode and terminate program
    subme dht-disconnect bye ;

: -bw ( -- )
    \O -bw
    \G -bw: disable color codes
    ['] drop is attr!  next-cmd ;

: -yes ( -- )