Check-in [4d5f84ca9e]
Not logged in

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

Overview
Comment:More work on better hash object fetching
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4d5f84ca9e6573fb1a3c43f2f25bf56a15e9894c
User & Date: bernd 2020-05-19 21:18:16
Context
2020-05-21
09:02
Flag for exception check-in: 1f47e4cfab user: bernd tags: trunk
2020-05-19
21:18
More work on better hash object fetching check-in: 4d5f84ca9e user: bernd tags: trunk
11:07
More work on fetching hashes (untested) check-in: bef65e85ed user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to debugging.fs.

83
84
85
86
87
88
89

90
91
92
93
94
95
96
debug: wallet( \ debug wallet stuff
debug: qr( \ qr code stuff
debug: deprecated( \ deprecated stuff
debug: unhandled( \ unhandled commands
debug: syncfile( \ synchronous file operations
debug: newvault( \ new style vault keys
debug: pks( \ fetch pks


-db profile( \ don't profile by default )
+db ipv6( \ ipv6 should be on by default )
+db ipv4( \ ipv4 should be on by default )
-db ipv64( \ ipv6 over 4
-db xlat464( \ no xlat 464 by default
-db newvault( \ new vault disabled for now )







>







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
debug: wallet( \ debug wallet stuff
debug: qr( \ qr code stuff
debug: deprecated( \ deprecated stuff
debug: unhandled( \ unhandled commands
debug: syncfile( \ synchronous file operations
debug: newvault( \ new style vault keys
debug: pks( \ fetch pks
debug: fetch( \ fetch hashed objects

-db profile( \ don't profile by default )
+db ipv6( \ ipv6 should be on by default )
+db ipv4( \ ipv4 should be on by default )
-db ipv64( \ ipv6 over 4
-db xlat464( \ no xlat 464 by default
-db newvault( \ new vault disabled for now )

Changes to msg.fs.

605
606
607
608
609
610
611

612
613
614
615
616
617
618
619








620
621
622

623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
    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

event: :>hash-finished { d: hash -- }

    hash fetch# #@ IF  cell+ .fetcher:got-it  ELSE  drop  THEN
    hash fetch-finish# #@ dup IF
	bounds U+DO
	    I @ >r hash r@ execute r> >addr free throw
	cell +LOOP
	last# bucket-off
    ELSE  2drop  THEN
    hash >ihave  hash drop free throw ;









: fetch-hashs ( addr u tsk pk$ -- )
    { tsk pk$ | hashs }

    bounds U+DO
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	I' I U+DO
	    false  I keysize have# $@ dup IF
		bounds U+DO
		    I $@ pk$ $@ str= or
		cell +LOOP
	    ELSE  2drop  THEN
	    IF
		I keysize net2o:copy#
		I keysize save-mem tsk [{: d: hash tsk :}h
		    <event hash e$, :>hash-finished tsk event> ;]
		lastfile@ >o to file-xt o>
		1 +to hashs
	    THEN
	    hashs $10 u>= ?LEAVE
	keysize +LOOP
	end-code| net2o:close-all
    keysize hashs *  0 to hashs  +LOOP ;








>








>
>
>
>
>
>
>
>



>









|
<
<
<







605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642



643
644
645
646
647
648
649
    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

event: :>hash-finished { d: hash -- }
    fetch( ." finished " 2dup 85type forth:cr )
    hash fetch# #@ IF  cell+ .fetcher:got-it  ELSE  drop  THEN
    hash fetch-finish# #@ dup IF
	bounds U+DO
	    I @ >r hash r@ execute r> >addr free throw
	cell +LOOP
	last# bucket-off
    ELSE  2drop  THEN
    hash >ihave  hash drop free throw ;

: fetch-hash ( hashaddr u tsk -- )
    >r save-mem
    fetch( ." fetching " 2dup 85type forth:cr )
    2dup fetch# #@ IF  cell+ .fetcher:fetch  ELSE  drop  THEN
    2dup net2o:copy#
    r> [{: d: hash tsk :}h <event hash e$, :>hash-finished tsk event> ;]
    lastfile@ >o to file-xt o> ;

: fetch-hashs ( addr u tsk pk$ -- )
    { tsk pk$ | hashs }
    fetch( ." fetch from " pk$ $@ .@host.id forth:cr )
    bounds U+DO
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	I' I U+DO
	    false  I keysize have# $@ dup IF
		bounds U+DO
		    I $@ pk$ $@ str= or
		cell +LOOP
	    ELSE  2drop  THEN
	    IF
		I keysize tsk fetch-hash



		1 +to hashs
	    THEN
	    hashs $10 u>= ?LEAVE
	keysize +LOOP
	end-code| net2o:close-all
    keysize hashs *  0 to hashs  +LOOP ;