Better ihave behavior

parent 64a7a390
...@@ -900,6 +900,8 @@ hash#128 buffer: hash-save ...@@ -900,6 +900,8 @@ hash#128 buffer: hash-save
slurp-file over >r hash-in 2drop r> free throw ; slurp-file over >r hash-in 2drop r> free throw ;
: hash-out ( addr u -- ) : hash-out ( addr u -- )
base85>$ 2dup 2>r read-enc-hashed patch-in$ $@ 2r> hash-85 spit-file ; base85>$ 2dup 2>r read-enc-hashed patch-in$ $@ 2r> hash-85 spit-file ;
: hash-rm ( addr u -- )
base85>$ enchash>filename delete-file drop ;
\ pull and sync a database \ pull and sync a database
......
...@@ -1093,7 +1093,9 @@ hash: imgs# \ hash of images ...@@ -1093,7 +1093,9 @@ hash: imgs# \ hash of images
img>group# dup 0< IF drop EXIT THEN img>group# dup 0< IF drop EXIT THEN
last# cell+ $@ album-imgs[] $! last# cell+ $@ album-imgs[] $!
album-prepare album-prepare
[: 1 64s /string ?read-enc-hashed save-mem ;] is load-img [: 1 64s /string ['] ?read-enc-hashed catch
IF 2drop thumb.png$ $@
ELSE save-mem THEN ;] is load-img
4 album-reload 4 album-reload
md-frame album-viewer >o to parent-w o> md-frame album-viewer >o to parent-w o>
album-viewer md-frame .childs[] >stack album-viewer md-frame .childs[] >stack
......
...@@ -61,8 +61,8 @@ warnings ! ...@@ -61,8 +61,8 @@ warnings !
I c@ $80 or $80 + cells hash @ + to hash I c@ $80 or $80 + cells hash @ + to hash
LOOP 2drop #0. ; LOOP 2drop #0. ;
: #+! ( addr1 u1 addr2 u2 -- ) : #+! ( addr1 u1 addr2 u2 hash -- ) >r
2dup #@ d0= IF #! ELSE 2drop last# cell+ $+! THEN ; 2dup r@ #@ d0= IF r> #! ELSE 2drop rdrop last# cell+ $+! THEN ;
: #free ( addrkey u hash -- ) { hash } : #free ( addrkey u hash -- ) { hash }
2dup string-hash hash$ bounds ?DO 2dup string-hash hash$ bounds ?DO
......
...@@ -305,14 +305,22 @@ Variable fetch-queue[] ...@@ -305,14 +305,22 @@ Variable fetch-queue[]
hash: ihave# hash: ihave#
: .ihaves ( -- )
." ====== hash owend by ======" cr
ihave# [: dup $@ 85type ." :"
cell+ $@ bounds U+DO
space '@' emit
I $@ 2dup keysize2 safe/string type '.' emit
key2| .simple-id
cell +LOOP cr ;] #map ;
: msg:ihave ( id u1 hash u2 -- ) : msg:ihave ( id u1 hash u2 -- )
2dup ihave$ $! 2over mehave$ $!
\ ." ihave:" 2over dump 2dup dump \ ." ihave:" 2over dump 2dup dump
2dup ihave$ $+! 2over mehave$ $!
bounds U+DO 2dup I keysize ihave# #!ins[] keysize +LOOP 2drop ; bounds U+DO 2dup I keysize ihave# #!ins[] keysize +LOOP 2drop ;
: pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ; : pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ;
: >ihave ( hash u -- ) : >ihave ( hash u -- )
2dup ihave$ $+! pk.host 2swap msg:ihave ;
pk.host 2dup mehave$ $! 2swap msg:ihave ;
: push-msg ( o:parent -- ) : push-msg ( o:parent -- )
up@ receiver-task <> IF up@ receiver-task <> IF
...@@ -507,43 +515,47 @@ scope: logstyles ...@@ -507,43 +515,47 @@ scope: logstyles
pk .key-id ." : " perm 64@ 64>n .perms space pk .key-id ." : " perm 64@ 64>n .perms space
; msg-class is msg:perms ; msg-class is msg:perms
event: :>hash-finished { d: hash } event: :>hash-finished { d: hash -- }
hash fetch-finish# #@ IF hash fetch-finish# #@ IF
@ >r hash r@ execute r> >addr free throw @ >r hash r@ execute r> >addr free throw
last# bucket-off last# bucket-off
ELSE drop THEN ; ELSE drop THEN
hash >ihave hash drop free throw ;
: fetch-queue { task w^ want# -- } : fetch-queue { tsk w^ want# -- }
want# [: >r want# tsk [{: tsk :}l { item }
r@ $@ $8 $E pk-connect? IF +resend +flow-control item $@ $8 $E pk-connect? IF +resend +flow-control
r@ cell+ $@ bounds U+DO item cell+ $@ bounds U+DO
net2o-code expect+slurp $10 blocksize! $A blockalign! net2o-code expect+slurp $10 blocksize! $A blockalign!
I' I keysize $10 * + umin I U+DO I' I keysize $10 * + umin I U+DO
I keysize net2o:copy# I keysize net2o:copy#
I keysize task [{: d: hash task :}h I keysize save-mem tsk [{: d: hash tsk :}h
<event hash e$, :>hash-finished task event> ;] <event hash e$, :>hash-finished tsk event> ;]
lastfile@ >o to file-xt o> lastfile@ >o to file-xt o>
keysize +LOOP keysize +LOOP
end-code| net2o:close-all end-code| net2o:close-all
keysize $10 * +LOOP keysize $10 * +LOOP
disconnect-me disconnect-me
THEN rdrop ;] #map THEN ;] #map
want# #frees ; want# #frees ;
event: :>fetch-queue fetch-queue ; event: :>fetch-queue fetch-queue ;
: transmit-queue ( -- ) : transmit-queue ( queue -- )
{ | w^ want# } { w^ queue[] | w^ want# }
fetch-queue[] want# [{: want# :}l 2dup ihave# #@ dup IF queue[] want# [{: want# :}l 2dup ihave# #@ dup IF
cell/ 1- rng cells + $@ want# #+! cell/ 1- rng cells + $@
ELSE 2drop 2drop THEN ;] $[]map want# #+!
ELSE 2drop 2drop THEN ;] $[]map
queue[] $[]free
<event up@ elit, want# @ elit, :>fetch-queue ?query-task event> ; <event up@ elit, want# @ elit, :>fetch-queue ?query-task event> ;
Variable queue? Variable queue?
event: :>queued ( -- ) event: :>queued ( queue -- )
transmit-queue queue? off ; [: 0 fetch-queue[] !@ queue? off ;] resize-sema c-section
transmit-queue ;
: enqueue ( -- ) : enqueue ( -- )
queue? @ 0= IF queue? on <event :>queued up@ event> THEN ; -1 queue? !@ 0= IF <event :>queued up@ event> THEN ;
forward need-hashed? forward need-hashed?
: ?fetch ( addr u -- ) : ?fetch ( addr u -- )
...@@ -1511,6 +1523,9 @@ umethod /chat ( addr u -- ) ...@@ -1511,6 +1523,9 @@ umethod /chat ( addr u -- )
umethod /split ( addr u -- ) umethod /split ( addr u -- )
\U split split load \U split split load
\G split: reduce distribution load by reconnecting \G split: reduce distribution load by reconnecting
umethod /ihave ( addr u -- )
\U ihave print out ihave list
\G ihave: print out the hashes and their providers
end-class chat-cmds end-class chat-cmds
chat-cmds new Constant text-chat-cmd-o chat-cmds new Constant text-chat-cmd-o
...@@ -1637,6 +1652,7 @@ is /help ...@@ -1637,6 +1652,7 @@ is /help
:noname ( addr u -- ) :noname ( addr u -- )
2drop msg-group-o .msg:?lock 0= IF ." un" THEN ." locked" forth:cr 2drop msg-group-o .msg:?lock 0= IF ." un" THEN ." locked" forth:cr
; is /lock? ; is /lock?
' .ihaves is /ihave
$100 buffer: permchar>bits $100 buffer: permchar>bits
msg:role-admin# msg:key-admin# msg:moderator# or or 'a' permchar>bits + c! msg:role-admin# msg:key-admin# msg:moderator# or or 'a' permchar>bits + c!
......
...@@ -725,6 +725,10 @@ warnings ! ...@@ -725,6 +725,10 @@ warnings !
\G add#: add files to hash storage \G add#: add files to hash storage
?get-me ['] hash-add arg-loop ; ?get-me ['] hash-add arg-loop ;
: rm# ( -- )
\U rm# hash1 .. hashn
?get-me ['] hash-rm arg-loop ;
: out# ( -- ) : out# ( -- )
\U out# hash1 .. hashn \U out# hash1 .. hashn
\G out#: get files out of hash storage in clear \G out#: get files out of hash storage in clear
......
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