Commit eac09b2d authored by bernd's avatar bernd

Use Forward instead of Defer

parent 54bc0938
......@@ -76,7 +76,7 @@ $20 value hash-size#
scope{ n2o
:noname ( -- )
: help ( -- )
\U help [cmd1 .. cmdn]
\G help: print commands or details about specified command
?cr ?nextarg IF
......@@ -96,7 +96,7 @@ scope{ n2o
s" \O " ['] .usage search-help
." === Commands ===" cr
s" \U " ['] .usage search-help
THEN ; is help
THEN ;
}scope
......
......@@ -60,8 +60,8 @@ gen-table $freeze
punch-addrs $@ bounds ?DO I @ .n2o:dispose-addr cell +LOOP
punch-addrs $off defers extra-dispose ; is extra-dispose
:noname ( addr u -- o ) \G create a new address object from string
n2o:new-addr n:>o nest-cmd-loop o n:o> ; is new-addr
: new-addr ( addr u -- o ) \G create a new address object from string
n2o:new-addr n:>o nest-cmd-loop o n:o> ;
also net2o-base
: o-genaddr ( o -- ) >o \G create new address string from object
......@@ -100,8 +100,8 @@ previous
: .nat-addrs ( -- )
punch-addrs $@ bounds ?DO I @ .addr cr cell +LOOP ;
:noname ( addr u -- )
new-addr >o o .addr n2o:dispose-addr o> ; is .addr$
: .addr$ ( addr u -- )
new-addr >o o .addr n2o:dispose-addr o> ;
User dest-0key> \ pointer to dest-0key
User dest-0key< \ pointer to obtained dest-0key
......@@ -161,7 +161,7 @@ User dest-0key< \ pointer to obtained dest-0key
: .my-addrs ( -- )
my-addr[] [: .addr cr ;] $[]o-map ;
:noname addrs-off !my-addrs !my-addr$ ; is !my-addr
: !my-addr ( -- ) addrs-off !my-addrs !my-addr$ ;
\ merge addresses
......
......@@ -376,14 +376,14 @@ Defer .n-name ' noop is .n-name
: cmdsig ( -- addr ) last-2o 3 cells + ;
: net2o' ( "name" -- ) ' >body @ ;
Defer net2o:words
Forward net2o:words
: inherit-table ( addr u "name" -- )
' dup IS gen-table execute $! ;
Vocabulary net2o-base
Defer do-req>
Forward do-req>
: do-nest ( addr u flag -- )
dup >r validated or! nest-cmd-loop
......@@ -456,7 +456,6 @@ comp: drop cmdsig @ IF ')' parse 2drop EXIT THEN
pf@ ;
+net2o: end-with ( o:object -- ) \g end scope
do-req> n:o> ;
:noname o IF req? @ 0< IF end-with req? off THEN THEN ; is do-req>
+net2o: oswap ( o:nest o:current -- o:current o:nest )
do-req> n:oswap ;
+net2o: tru ( -- f:true ) \g true flag literal
......@@ -478,6 +477,10 @@ comp: drop cmdsig @ IF ')' parse 2drop EXIT THEN
string@ $> 2drop ;
}scope
also net2o-base
: do-req> o IF req? @ 0< IF end-with req? off THEN THEN ;
previous
gen-table $freeze
gen-table $@ inherit-table reply-table
......@@ -578,7 +581,7 @@ previous
1 packets2 +!
ELSE dest-addr 64@ [ cell 4 = ] [IF] 0<> - [THEN] dup 0 r> 2! u>= THEN ;
: cmd-loop ( addr u -- )
: cmd-exec ( addr u -- )
string-stack $off
object-stack $off
nest-stack $off
......@@ -595,8 +598,6 @@ previous
[: outflag @ >r cmdreset init-reply do-cmd-loop
r> outflag ! cmd-send? ;] cmdlock c-section ;
' cmd-loop is cmd-exec
\ nested commands
User neststart#
......@@ -711,7 +712,15 @@ $10 net2o: push' ( #cmd -- ) \g push command into answer packet
+net2o: error-id ( $:errorid -- ) \g error-id string
$> $error-id $! ;
:noname ( start -- )
gen-table $freeze
: ]nest ( -- ) ]nest$ push-$ push' nest ;
}scope
also net2o-base
: net2o:words ( start -- )
token-table $@ 2 pick cells safe/string bounds U+DO
I @ ?dup-IF
dup >net2o-sig 2>r >net2o-name
......@@ -719,13 +728,9 @@ $10 net2o: push' ( #cmd -- ) \g push command into answer packet
2 pick ulit, 2r> 2swap [: type type ;] $tmp $, token
ELSE 2drop rdrop rdrop THEN
THEN 1+
cell +LOOP drop ; IS net2o:words
gen-table $freeze
cell +LOOP drop ;
: ]nest ( -- ) ]nest$ push-$ push' nest ;
}scope
previous
0 [IF]
Local Variables:
......
......@@ -15,7 +15,7 @@
\ 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/>.
Defer >invitations
Forward >invitations
scope{ net2o-base
\ nat traversal functions
......
......@@ -401,13 +401,12 @@ also net2o-base
pings new-request false gen-punchload gen-punch ;
previous
:noname ( addr u -- )
: punch-reply ( addr u -- )
outflag @ >r cmdbuf-o @ >r
[: cmd0! cmdreset init-reply also net2o-base
[ also net2o-base ]
$, nest end-code ;] catch
r> cmdbuf-o ! r> outflag ! throw
; is punch-reply
r> cmdbuf-o ! r> outflag ! throw ;
: 0-resend? ( -- n )
resend0 @ IF
......
......@@ -362,8 +362,8 @@ $60 Constant rndkey#
: ?keysize ( u -- )
keysize <> !!keysize!! ;
Defer check-key \ check if we know that key
Defer search-key \ search if that is one of our pubkeys
Forward check-key \ check if we know that key
Forward search-key \ search if that is one of our pubkeys
: key-stage2 ( pk sk -- ) >r
keypad$ keysize <> !!no-tmpkey!!
......
......@@ -86,7 +86,7 @@ Variable announced
\ NAT retraversal
Defer insert-addr ( o -- )
Forward insert-addr ( o -- )
: renat ( -- )
msg-groups [:
......@@ -195,7 +195,7 @@ User host$ \ check for this hostname
: host= ( o -- flag )
host$ $@len IF .host-id $@ host$ $@ str= ELSE drop true THEN ;
:noname ( o -- flag )
: 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
......@@ -203,7 +203,7 @@ User host$ \ check for this hostname
ret-addr $10 0 skip nip 0= IF
temp-addr ret-addr $10 move
dest-0key< sec@ dup IF dest-0key> @ sec! ELSE 2drop THEN
THEN drop true ;] addr>sock ; is insert-addr
THEN drop true ;] addr>sock ;
: insert-addr$ ( addr u -- flag ) dest-0key dest-0key> !
new-addr dup insert-addr swap .n2o:dispose-addr ;
......
......@@ -99,7 +99,7 @@ User ip6:#
over c@ '0' = IF 2 safe/string THEN
over c@ '?' - 0 max safe/string ;
Defer .addr$
Forward .addr$
: .iperr ( addr len -- )
connect( [: <info> .time ." connected from: " .addr$ <default> cr ;] $err
......@@ -268,7 +268,7 @@ Variable myname
\ new address handling is in net2o-addr.fs, loaded later
Defer !my-addr
Forward !my-addr ( -- )
\ this looks ok
......
......@@ -386,7 +386,7 @@ event: ->search-key key| over >r dht-nick? r> free throw ;
: .simple-id ( addr u -- ) key>nick type ;
:noname ( addr u -- )
: check-key ( addr u -- )
o IF pubkey @ IF
2dup pubkey $@ key| str= 0= IF
[: ." want: " pubkey $@ key| 85type cr
......@@ -401,11 +401,11 @@ event: ->search-key key| over >r dht-nick? r> free throw ;
tmp-perm @ perm%blocked and IF
[: ." Unknown key, connection refused: " 85type cr ;] $err
true !!connect-perm!!
ELSE 2drop THEN ; IS check-key
ELSE 2drop THEN ;
:noname ( pkc -- skc )
: search-key ( pkc -- skc )
keysize key-table #@ 0= !!unknown-key!!
cell+ .ke-sk sec@ 0= !!unknown-key!! ; is search-key
cell+ .ke-sk sec@ 0= !!unknown-key!! ;
\ apply permissions
......@@ -922,15 +922,14 @@ event: ->wakeme ( o -- ) <event ->wake event> ;
invitations [: ." invite (y/n/b)? " 2dup .pk2key$ process-invitation
;] $[]map invitations $[]off ;
:noname ( addr u -- )
: >invitations ( addr u -- )
2dup filter-invitation? IF 2drop EXIT THEN
invitations $[]# >r
2dup invitations $ins[]sig drop
invitations $[]# r> <> IF
save-mem [ up@ ]l <hide>
<event e$, ->invite up@ elit, ->wakeme [ up@ ]l event> stop
ELSE 2drop THEN
; is >invitations
ELSE 2drop THEN ;
: send-invitation ( pk u -- )
setup! mypk2nick$ 2>r
gen-tmpkeys drop tskc swap keypad ed-dh do-keypad sec!
......@@ -990,7 +989,7 @@ Variable tries#
>raw-key ?rsk r> op-vector ! ;
scope: n2o
Defer help
Forward help
}scope
: get-me ( -- )
......
......@@ -247,7 +247,7 @@ event: ->msg-nestsig ( addr u o group -- )
drop ;
Forward msg:last?
Defer msg:last \ uses locals, forward not possible
Forward msg:last
: push-msg ( addr u o:parent -- )
up@ receiver-task <> IF
......@@ -439,11 +439,9 @@ Variable ask-msg-files[]
last# $@ $, msg-group
max-last# umin
last-msgs@ >r $, r> ulit, msg-last ;
:noname ( $:[tick0,tick1,...,tickn] n -- )
ask-msg-files[] $[]off
forth:. ." Messages:" forth:cr
: ?ask-msg-files ( addr u -- )
64#-1 64#0 { 64^ startd 64^ endd } \ byte order of 0 and -1 don't matter
last# >r last# $@ ?msg-log
last# $@ ?msg-log
$> bounds ?DO
I' I 64'+ u> IF
I le-64@ date>i
......@@ -463,11 +461,15 @@ Variable ask-msg-files[]
startd le-64@ 64#-1 64<> IF
endd startd [: 1 64s forth:type 1 64s forth:type last# $. ;]
ask-msg-files[] dup $[]# swap $[] $exec
THEN
THEN ;
: msg:last ( $:[tick0,tick1,...,tickn] n -- )
last# >r ask-msg-files[] $[]off
forth:. ." Messages:" forth:cr
?ask-msg-files
parent @ >o $10 blocksize! $4 blockalign!
ask-msg-files[] [: n2o:copy-msg ;] $[]map
n2o:done o>
r> to last# ; is msg:last
r> to last# ;
:noname ( -- 64len )
\ poll serializes the
......
......@@ -154,7 +154,7 @@ Defer write-decrypt
r@ write-file throw r> forth:close-file throw ;
: vault>file ['] write-1file is write-decrypt ;
vault>file
: vault>out [: forth:type ;] is write-decrypt ;
: vault>out ['] forth:type is write-decrypt ;
: decrypt-file ( filename u -- )
enc-filename $!
......
......@@ -953,9 +953,9 @@ scope{ mapc
over data-map @ .mapc:resend#+ set-dest#
>send ack@ .bandwidth+ send-data-packet ;
Defer punch-reply
Defer addr>sock
Defer new-addr
Defer addr>sock \ uses locals
Forward punch-reply
Forward new-addr
: send-punch ( addr u -- addr u )
check-addr1 0= IF 2drop EXIT THEN
......@@ -1388,8 +1388,7 @@ Variable timeout-tasks s" " timeout-tasks $!
\ handling packets
Defer cmd-exec ( addr u -- )
' dump IS cmd-exec
Forward cmd-exec ( addr u -- )
: !!<order? ( n -- ) dup c-state @ u> !!inv-order!! c-state or! ;
: !!>order? ( n -- ) dup c-state @ u<= !!inv-order!! c-state or! ;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment