Check-in [77cdb0b452]
Not logged in

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

Overview
Comment:Add chat permission settings
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:77cdb0b4529138379b65e63e1fb5defa81e417db
User & Date: bernd 2019-07-15 21:37:01
Context
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
2019-07-14
21:15
Lock/unlock of chat looks good now check-in: ff117dd91d user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to classes.fs.

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

144
145
146
147
148
149
150
...
151
152
153
154
155
156
157




158
159
160
161
162
163
164
...
168
169
170
171
172
173
174

175
176
177
178
179
180
181
    64field: lastdeltat
end-class ack-class

cmd-class class
    field: silent-last#
end-class msging-class


cmd-class class{ msg
    $10 +field dummy
    $value: name$ \ group name
    $value: id$
    $value: msg$  \ decrypted message
    field: peers[]
    field: keys[]
    field: log[]

    field: mode
    \ mode bits:
    1 4 bits: otr# redate# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}
	'+' gen-name create dup , [: @        mode or!  ;] set-does>
................................................................................
	'-' gen-name create dup , [: @ invert mode and! ;] set-does>
	'?' gen-name create     , [: @ mode @ and 0<>   ;] set-does> ;
    otr#     bit-ops: otr
    redate#  bit-ops: redate
    lock#    bit-ops: lock
    visible# bit-ops: visible





    method start
    method tag
    method chain
    method signal
    method re
    method text
    method object
................................................................................
    method otrify
    method payment
    method url
    method like
    method lock
    method unlock
    method away

    method end
    method display   \ display one message
    method redisplay \ display full set
    method .nobody   \ show nobody is online
}class

cmd-class class{ pay







<








>







 







>
>
>
>







 







>







128
129
130
131
132
133
134

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
...
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    64field: lastdeltat
end-class ack-class

cmd-class class
    field: silent-last#
end-class msging-class


cmd-class class{ msg
    $10 +field dummy
    $value: name$ \ group name
    $value: id$
    $value: msg$  \ decrypted message
    field: peers[]
    field: keys[]
    field: log[]
    field: perms# \ pk -> permission map
    field: mode
    \ mode bits:
    1 4 bits: otr# redate# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}
	'+' gen-name create dup , [: @        mode or!  ;] set-does>
................................................................................
	'-' gen-name create dup , [: @ invert mode and! ;] set-does>
	'?' gen-name create     , [: @ mode @ and 0<>   ;] set-does> ;
    otr#     bit-ops: otr
    redate#  bit-ops: redate
    lock#    bit-ops: lock
    visible# bit-ops: visible

    1 4 bits: role-admin# key-admin# moderator# troll#
    \ key admins can set keys, role-admins can set roles
    \ moderators can cancel other's and trolls are muted (they don't know)

    method start
    method tag
    method chain
    method signal
    method re
    method text
    method object
................................................................................
    method otrify
    method payment
    method url
    method like
    method lock
    method unlock
    method away
    method perms
    method end
    method display   \ display one message
    method redisplay \ display full set
    method .nobody   \ show nobody is online
}class

cmd-class class{ pay

Changes to err.fs.

116
117
118
119
120
121
122

123
124
125
126
127
128
129
s" Invalid index"                throwcode !!inv-index!!
s" hash not last pk's state"     throwcode !!squid-hash!!
s" Double transaction!"          throwcode !!double-transaction!!
s" Insufficient asset!"          throwcode !!insufficient-asset!!
s" Transaction not balanced!"    throwcode !!not-balanced!!
s" Sink already cleared!"        throwcode !!sink-cleared!!
s" Sink not cleared!"            throwcode !!not-sunk!!


next-exception !

: sig-enum>throw ( enum -- throwcode )
    [ ' !!inv-sig!! >body @ 1- ]L swap - ;
: !!sig!! ( n -- )
    ?dup-IF  sig-enum>throw throw  THEN ;







>







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
s" Invalid index"                throwcode !!inv-index!!
s" hash not last pk's state"     throwcode !!squid-hash!!
s" Double transaction!"          throwcode !!double-transaction!!
s" Insufficient asset!"          throwcode !!insufficient-asset!!
s" Transaction not balanced!"    throwcode !!not-balanced!!
s" Sink already cleared!"        throwcode !!sink-cleared!!
s" Sink not cleared!"            throwcode !!not-sunk!!
s" Invalid permission!"          throwcode !!inv-perm!!

next-exception !

: sig-enum>throw ( enum -- throwcode )
    [ ' !!inv-sig!! >body @ 1- ]L swap - ;
: !!sig!! ( n -- )
    ?dup-IF  sig-enum>throw throw  THEN ;

Changes to keys.fs.

1436
1437
1438
1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
    case
	#-56 of .keyinfo true !!no-key-open!! endof
	#-28 of .keyinfo true !!no-key-open!! endof
	throw  0
    endcase ;

: args>keylist ( -- )

    [: nick-key ?dup-IF  >o ke-pk $@ o> keysize umin key-list $+[]!  THEN ;]
    @arg-loop ;

\\\
Local Variables:
forth-local-words:
    (







>







1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
    case
	#-56 of .keyinfo true !!no-key-open!! endof
	#-28 of .keyinfo true !!no-key-open!! endof
	throw  0
    endcase ;

: args>keylist ( -- )
    key-list $[]free
    [: nick-key ?dup-IF  >o ke-pk $@ o> keysize umin key-list $+[]!  THEN ;]
    @arg-loop ;

\\\
Local Variables:
forth-local-words:
    (

Changes to msg.fs.

366
367
368
369
370
371
372
373
374
375


376
377
378
379
380
381
382
...
417
418
419
420
421
422
423

424
425
426
427
428
429
430
...
461
462
463
464
465
466
467






468
469
470
471
472
473
474
...
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
....
1362
1363
1364
1365
1366
1367
1368



1369
1370
1371
1372
1373
1374
1375
....
1496
1497
1498
1499
1500
1501
1502

















1503
1504
1505
1506
1507
1508
1509
    8 !!>=order? $> msg:coord ;
+net2o: msg-url ( $:url -- ) \g specify message URL
    $> msg:url ;
+net2o: msg-like ( xchar -- ) \g add a like
    64>n msg:like ;
+net2o: msg-lock ( $:key -- ) \g lock down communciation
    $> msg:lock ;
+net2o: msg-unlock ( -- )
    msg:unlock ;



}scope

msg-table $save

' context-table is gen-table

\ Code for displaying messages
................................................................................
    2dup [: ." @" .simple-id ;] $tmp notify+ ; msg-notify-class is msg:signal
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:text
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:url
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:action
' drop  msg-notify-class is msg:like
' 2drop  msg-notify-class is msg:lock
' noop  msg-notify-class is msg:unlock

' drop  msg-notify-class is msg:away
' 2drop msg-notify-class is msg:coord
:noname 2drop 2drop ; msg-notify-class is msg:otrify
:noname ( -- ) msg-notify ; msg-notify-class is msg:end
:noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like

:noname ( addr u -- )
................................................................................
	<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 ( 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
	msg:message#   of  ." message["  85type  endof
................................................................................
\ 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 ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: ?search-lock ( addr u -- )
    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
................................................................................
    \G lock: lock down communication to list of nicks
umethod /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
umethod /lock? ( addr u -- )
    \U lock?                check lock status
    \G lock?: report lock status



umethod /bye ( addr u -- )
    \U bye
    \G bye: leaves the current chat
umethod /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
umethod /split ( addr u -- )
................................................................................
:noname ( addr u -- )
    2drop msg-group-o .msg:-lock
    [: net2o-base:msg-unlock ;] send-avalanche
; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?


















:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
}scope

: ?slash ( addr u -- addr u flag )
    over c@ dup '/' = swap '\' = or ;







|

<
>
>







 







>







 







>
>
>
>
>
>







 







|







 







>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







366
367
368
369
370
371
372
373
374

375
376
377
378
379
380
381
382
383
...
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
...
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
....
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
....
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
....
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
    8 !!>=order? $> msg:coord ;
+net2o: msg-url ( $:url -- ) \g specify message URL
    $> msg:url ;
+net2o: msg-like ( xchar -- ) \g add a like
    64>n msg:like ;
+net2o: msg-lock ( $:key -- ) \g lock down communciation
    $> msg:lock ;
+net2o: msg-unlock ( -- ) \g unlock communication
    msg:unlock ;

+net2o: msg-perms ( $:pk perm -- ) \g permissions
    $> msg:perms ;
}scope

msg-table $save

' context-table is gen-table

\ Code for displaying messages
................................................................................
    2dup [: ." @" .simple-id ;] $tmp notify+ ; msg-notify-class is msg:signal
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:text
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:url
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:action
' drop  msg-notify-class is msg:like
' 2drop  msg-notify-class is msg:lock
' noop  msg-notify-class is msg:unlock
:noname 2drop 64drop ; msg-notify-class is msg:perms
' drop  msg-notify-class is msg:away
' 2drop msg-notify-class is msg:coord
:noname 2drop 2drop ; msg-notify-class is msg:otrify
:noname ( -- ) msg-notify ; msg-notify-class is msg:end
:noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like

:noname ( addr u -- )
................................................................................
	<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
	msg:message#   of  ." message["  85type  endof
................................................................................
\ 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 -- )
    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
................................................................................
    \G lock: lock down communication to list of nicks
umethod /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
umethod /lock? ( addr u -- )
    \U lock?                check lock status
    \G lock?: report lock status
umethod /perms ( addr u -- )
    \U perms roles {@keys}  set and change permissions of users
    \G perms: set permissions
umethod /bye ( addr u -- )
    \U bye
    \G bye: leaves the current chat
umethod /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
umethod /split ( addr u -- )
................................................................................
:noname ( addr u -- )
    2drop msg-group-o .msg:-lock
    [: net2o-base:msg-unlock ;] send-avalanche
; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?

$100 buffer: permchar>bits
msg:role-admin# msg:key-admin# msg:moderator# or or 'a' permchar>bits + c!
msg:role-admin# 'r' permchar>bits + c!
msg:key-admin#  'k' permchar>bits + c!
msg:moderator#  'm' permchar>bits + c!
msg:troll#      't' permchar>bits + c!
: >perms ( addr u -- perms )
    0 -rot bounds ?DO  I c@ permchar>bits + c@
	dup 0= !!inv-perm!! or  LOOP ;

:noname ( addr u -- )
    word-args [: parse-name >perms args>keylist ;] execute-parsing
    [{: perm :}l
	perm key-list [: key| $, dup ulit, net2o-base:msg-perms ;] $[]map drop
    ;] send-avalanche
; is /perms

:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
}scope

: ?slash ( addr u -- addr u flag )
    over c@ dup '/' = swap '\' = or ;

Changes to wiki/commands.md.

388
389
390
391
392
393
394



395
396
397
398
399
400
401
* $2C msg-url ( $:url -- )
  specify message URL
* $2D msg-like ( xchar -- )
  add a like
* $2E msg-lock ( $:key -- )
  lock down communciation
* $2F msg-unlock ( -- )




### group description commands ###

* $20 group-name ( $:name -- )
  group symbolic name
* $21 group-id ( $:group -- )
  group id, is a pubkey







>
>
>







388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
* $2C msg-url ( $:url -- )
  specify message URL
* $2D msg-like ( xchar -- )
  add a like
* $2E msg-lock ( $:key -- )
  lock down communciation
* $2F msg-unlock ( -- )
  unlock communication
* $30 msg-perms ( $:pk perm -- )
  permissions

### group description commands ###

* $20 group-name ( $:name -- )
  group symbolic name
* $21 group-id ( $:group -- )
  group id, is a pubkey