0 +field start-strings
    field: resend0
    field: data-resend
    field: pubkey        \ other side official pubkey
    field: rqd-xts       \ callbacks for request done (array)
    field: my-error-id
    field: beacon-hash
    field: slurp#$       \ slurp id+num string
    field: spit#$        \ spit id+num string
    0 +field end-strings
    field: dest-addrs    \ list of destinations
    field: punch-addrs   \ list of punch destinations
    field: request-gen   \ pre-generated request number
    field: perm-mask
    \ secrets
    0 +field start-secrets

# 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.9.7-20200116], [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])

\ 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/>.

\ everything that follows here can assume to have a connection context

forward slurp,

scope{ net2o-base

connect-table $@ inherit-table context-table

\ generic functions
\g 

    >r 64>n r> data-rmap with mapc
	over dest-top <> and false dest-end ?!@ drop \ atomic, replaces or!
	dest-top!
    endwith ;
+net2o: slurp ( -- ) \g slurp in tracked files
    \ !!FIXME!! this should probably be asynchronous
    net2o:slurp swap ulit, flag, set-top
    slurp,
    ['] do-track-seek net2o:track-all-seeks net2o:send-chunks ;
+net2o: ack-reset ( -- ) \g reset ack state
    0 ack-state c! ;
+net2o: slurped ( $slurped -- ) \g respond to slurped stuff
    $> spit#$ $+! ;

in forth : slurp, ( -- )
    slurp#$ $@ $, slurped  slurp#$ $free ;

\ object handles
\g 
\g ### file commands ###
\g 

$30 net2o: file-id ( uid -- o:file ) \g choose a file object

: fstate-free ( -- )  file-state @ 0= ?EXIT
    [: fstates-free file-state $free ;] file-sema c-section ;
in net2o : save-block ( back tail id -- delta ) { id -- delta }
    data-rmap with mapc fix-size raddr+ endwith residualwrite @ umin
    id id>addr? .fs-write
    file1( id f-wid @ = IF  dup f-wamount +!
    ELSE  f-wid @ 0>= f-wamount @ 0> and IF
	    ." spit: " f-wid @ . f-wamount @ hex. cr  THEN
        id f-wid ! dup f-wamount !  THEN )
    >blockalign dup negate residualwrite +! ;

\ careful: must follow exactly the same logic as slurp (see below)

: .spit ( -- )
    spit#$ $@ 2dup dump
    bounds ?DO  I c@ hex. I 1+ p2@+ >r x64. cr r> I - +LOOP ;

in net2o : spit { back tail -- newback }
    back tail back u<= ?EXIT fstates 0= ?EXIT drop
    slurp( ." spit: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr ) back tail
    [: +calc fstates 0 { back tail states fails }
	BEGIN  tail back u>  WHILE
		back tail write-file# @ net2o:save-block dup +to back
		IF 0 ELSE fails 1+ residualwrite off THEN to fails
		residualwrite @ 0= IF
		    write-file# file+ blocksize @ residualwrite !  THEN
	    fails states u>= UNTIL
	THEN
	msg( ." Write end" cr ) +file
	back  fails states u>= IF  >maxalign  THEN  \ if all files are done, align
    ;] file-sema c-section
    slurp( .spit ) spit#$ $free
    slurp( ."  left: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr ) ;

: save-to ( addr u n -- )  state-addr .fs-create ;
: save-to# ( addr u n -- )  state-addr >o  1 fs-class!  fs-create o> ;

\ file status stuff

: open-file ( addr u mode id -- )
    state-addr .fs-open ;

\ read in from files

: slurp-block { id -- delta }
    data-head@ id id>addr? .fs-read
    dup IF  id slurp#$ c$+! dup u>64 slurp#$ p2$+!
	dup >blockalign over - ?dup-IF
	    $FF slurp#$ c$+! u>64 slurp#$ p2$+!
	THEN
    THEN
    dup /head
    file1( id f-rid @ = IF  dup f-ramount +!
    ELSE  f-rid @ 0>=  f-ramount @ 0> and IF
	    ." slurp: " f-rid @ . f-ramount @ hex. cr  THEN
        id f-rid ! dup f-ramount !  THEN ) ;

\ careful: must follow exactpy the same logic as net2o:spit (see above)
: slurp ( -- head end-flag )
    data-head? 0= fstates 0= or  IF  head@ 0  EXIT  THEN
    slurp( ." slurp: " data-head@ drop data-map with mapc dest-raddr - endwith hex.
    read-file# ? residualread @ hex. forth:cr )

: read-avatar ( addr u -- addr' u' )
    ?read-enc-hashed mem>thumb atlas-region ;
Variable user-avatar#
Variable dummy-thumb#
Variable user.png$
Variable thumb.png$


: read-user.png ( -- )
    [ "doc/user.png" ]path user.png$ $slurp-file ;
: read-thumb.png ( -- )
    [ "minos2/thumb.png" ]path thumb.png$ $slurp-file ;
: user-avatar ( -- addr )
    user-avatar# @ 0= IF
	read-user.png user.png$ $@ mem>thumb atlas-region

: escape-<&> ( addr u -- )
    bounds ?DO  case i c@
	    '<' of  ." &lt;"   endof
	    '>' of  ." &gt;"   endof
	    '&' of  ." &amp;"  endof
	    '"' of  ." &quot;" endof
	    emit  0 endcase  LOOP ;

















: build-notification ( -- ) ;
: notify@ ( -- addr u )
    config:notify-text# @ IF
	notify-otr? @ config:notify-text# @ 0> and IF
	    "<i>[otr] message</i>"
	ELSE  notify$ $@ ['] escape-<&> $tmp  THEN

    upath $@ bounds ?DO I c@ ':' = IF 0 I c! THEN LOOP
    "notify-send" upath file>abspath notify-send $!
    upath $free ;

: !net2o-logo ( -- )
    s" ../doc/net2o-logo.png" fpath file>abspath net2o-logo $! ;

!upath !net2o-logo

[IFDEF] use-execve
    : ?free0 ( addr -- )
	dup 0= IF  drop  EXIT  THEN  @ free throw ;
    : !notify-args ( -- )
	title-string   ?free0
	content-string ?free0
	here >r notify-args dp !
	"notify-send\0" drop ,
	"-a\0" drop ,
	"net2o\0" drop ,
	"-c\0" drop ,
	"im.received\0" drop ,
	net2o-logo $@len IF
	    "-i\0" drop ,
	    net2o-logo $@ drop ,
	THEN
	here to title-string 0 ,
	here to content-string 0 ,
	0 , \ must be terminated by null pointer
	r> dp ! ;

    !notify-args
[THEN]

:noname defers 'cold
    !upath !net2o-logo [IFDEF] !notify-args !notify-args [THEN] ; is 'cold

: linux-notification ( -- )  notify-send $@len 0= ?EXIT
    [IFDEF] use-execve
	\ for now unknown reasons, notify-send doesn't like this way of
	\ being called
	notify@ content-string 0$!
	['] notify-title $tmp dup 0= IF  2drop  EXIT  THEN  title-string 0$!
	notify-send $@ notify-args fork+exec
    [ELSE]
	\ Use variables to avoid needing to quote stuff
	\ Unfortunately, HTML quoting still needed
	"TITLE" ['] notify-title $tmp ['] escape-<&> $tmp 1 setenv ?ior
	"MESSAGE" notify@ 1 setenv ?ior
	[: notify-send $. space
	    ." -a net2o -c im.received "
	    net2o-logo $@len IF
		." -i " net2o-logo $. space  THEN
	    .\" \"$TITLE\" \"$MESSAGE\""

	;] $tmp system
	"TITLE" unsetenv ?ior
	"MESSAGE" unsetenv ?ior
    [THEN] ;

		    a[] over cells cell $del
		ELSE
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;

forward msg-scan-hash
forward msg-add-hashs
forward msg-serialize-hash

: serialize-log ( addr u -- $addr )
    [: [: bounds ?DO
		I $@ check-date 0= IF
		    2dup msg:display
		    net2o-base:$, net2o-base:nestsig
		ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
	    cell +LOOP
	    msg-serialize-hash
	;] msg-scan-hash ;] gen-cmd ;

: scan-log-hashs ( -- )
    msg-log@ over >r
    [: bounds ?DO
	    I $@ msg:display
	cell +LOOP
	msg-add-hashs
    ;] msg-scan-hash r> free throw ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages in group " msg-group-o dup hex. .msg:name$ type cr )
    ?.net2o/chats  net2o:new-msging >o
    msg-log@ over >r  serialize-log enc-file $!buf

Forward msg:last?
Forward msg:last
Forward msg:want

hash: fetch-finish#
Variable fetch-queue[]

hash: have#

: .@host.id ( pk+host u -- )
    '@' emit
    2dup keysize2 safe/string type '.' emit
    key2| .simple-id ;
: .ihaves ( -- )
    ." ====== hash owend by ======" cr
    have# [: dup $@ 85type ." :"
	cell+ $@ bounds U+DO
	    space I $@ .@host.id
	cell +LOOP cr ;] #map ;

: msg:ihave ( id u1 hash u2 -- )
\    ." ihave:" 2over dump 2dup dump
    2dup ihave$ $+!  2over mehave$ $!
    bounds U+DO  2dup I keysize have# #!ins[]  keysize +LOOP  2drop ;
: pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ;
: >ihave ( hash u -- )
    pk.host 2swap  msg:ihave ;

: push-msg ( o:parent -- )
    up@ receiver-task <> IF
	avalanche-msg

: fetch-queue 0 .pk.host $make { tsk w^ want# w^ pk$ -- }
    want# tsk pk$ [{: tsk pk$ :}l { item }
	item $@ $8 $E pk-connect? IF  +resend +flow-control
	    { | hashs }
	    item cell+ $@ bounds U+DO
		net2o-code expect+slurp $10 blocksize! $A blockalign!
		I' I U+DO
		    I keysize have# $@ dup IF
			0 -rot bounds U+DO
			    I $@ pk$ $@ str= or
			cell +LOOP
		    ELSE  2drop true  THEN
		    IF
			I keysize net2o:copy#
			I keysize save-mem tsk [{: d: hash tsk :}h

    want# #frees
    pk$ $free ;

event: :>fetch-queue fetch-queue ;

: transmit-queue ( queue -- )
    { w^ queue[] | w^ want# }
    queue[] want# [{: want# :}l 2dup have# #@ dup IF
	    bounds U+DO
		2dup I $@ want# #+!
	    cell +LOOP  2drop
	ELSE  2drop 2drop  THEN ;] $[]map
    queue[] $[]free
    <event up@ elit, want# @ elit, :>fetch-queue ?query-task event> ;

:noname 2dup msg-dec?-sig? ; msg-class is nest-sig

' context-table is gen-table

also }scope

\ serialize hashes

: ?ihave ( addr u pk$ want# -- ) { pk$ want# -- }
    2dup need-hashed? 0= IF
	pk$ $@ 2over have# #!ins[]
	2dup pk$ $@ want# #+!
    THEN ;
: msg-add-hashs ( -- )
    0 .pk.host $make { w^ pk$ }
    ?hashs[] pk$ [{: pk$ :}l
	2dup need-hashed? 0= IF
	    pk$ $@ 2over have# #!ins[]
	THEN  2drop
    ;] $[]map
    ?hashs[] $[]free
    pk$ $free ;

: msg-serialize-hash ( -- )
    0 .pk.host $make { w^ pk$ | w^ want# }
    ?hashs[] want# pk$ [{: want# pk$ :}l




	2dup have# #@ dup IF
	    false { flag }
	    bounds U+DO
		2dup I $@ want# #+!
		I $@ pk$ $@ str= +to flag
	    cell +LOOP
	    flag 0= IF  pk$ want# ?ihave  THEN
	ELSE
	    2drop  pk$ want# ?ihave
	THEN
	2drop
    ;] $[]map
    want# [:
	msg( dup $@ .@host.id ." : " dup cell+ $@ 85type forth:cr )
	dup cell+ $@ $, $@ $, msg-ihave ;] #map
    ?hashs[] $[]free
    want# #frees

$20 Value max-last#
$20 Value ask-last#

$8 Value max-want#
: have>want ( hashs u want# -- ) { want# }
    \ transform have into wants
    bounds U+DO
	I keysize have# #@ bounds U+DO
	    J keysize I $@ want# #+!
	cell +LOOP
    keysize +LOOP ;
: want, ( index -- )
    \ compile a single want
    over $@len over cell+ $@len + 8 + maxstring u< IF
	dup cell+ $@ $, $@ $, msg-ihave

    \G split: reduce distribution load by reconnecting
umethod /have ( addr u -- )
    \U have                 print out have list
    \G have: print out the hashes and their providers
umethod /imgs ( addr u -- )
    \U imgs                 print out img list
    \G imgs: print out hashes for album viewer
umethod /rescan# ( addr u -- )
    \U rescan#              rescan for hashes
    \G rescan#: search the entire chat log for hashes and if you have them
end-class chat-cmds

chat-cmds new Constant text-chat-cmd-o

text-chat-cmd-o to chat-cmd-o

' 2drop is /imgs \ stub

    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?
' .ihaves is /have
' scan-log-hashs is /rescan#

$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!

    64dup 64-0< n>64 64swap 64-2* 64xor ;

: ps!+ ( 64n addr -- addr' )
    >r n>zz r> p!+ ;
: ps@+ ( addr -- 64n addr' )
    p@+ >r zz>n r> ;

\ compact representation of mostly power-of-two numbers

: p2@+ ( addr -- 64bit addr' )
    count >r r@ $C0 u>= IF
	64#1 r> $3F and 64lshift n64-swap  EXIT  THEN
    r@ $0F and u>64 r> 4 rshift 8 umin 0 ?DO
	8 64lshift 64>r count u>64 64r> 64+
    LOOP  n64-swap ;
: p2$+! ( 64bit addr -- )
    >r
    64dup $F u>64 64u> IF
	64dup 64dup 64#1 64- 64and 64-0= IF
	    64>f fdup f* { | w^ ff1 }
	    ff1 sf! ff1 [ 3 pad ! pad c@ ]L + c@ $3F - $C0 or
	    r> c$+!  EXIT  THEN
	THEN
    0 >r <#
    BEGIN   64dup $F u>64 64u>  WHILE
	    64dup 64>n $FF and hold 8 64rshift
	    r> $10 + >r
    REPEAT
    64>n r> or hold #0. #> r> $+! ;

\ bit reversing

: bitreverse8 ( u1 -- u2 )
    0 8 0 DO  2* over 1 and + swap 2/ swap  LOOP  nip ;

Create reverse-table $100 0 [DO] [I] bitreverse8 c, [LOOP]

#10.000.000.000. savedelta& 2! \ 10 seconds deltat
#3600.000.000.000. ekey-timeout& 2! \ one hour ekey timeout
#60.000.000.000. dht-cleaninterval& 2! \ one minute dht clean interval
#50.000.000.000. beacon-ticks& 2!
#2.000.000.000. beacon-short-ticks& 2!

: ]path ( addr u -- )
    file>fpath ]] SLiteral [[ ] ;

: .net2o-config/ ( addr u -- addr' u' ) [: .net2o-config$ $. '/' emit type ;] $tmp ;
: .net2o-cache/ ( addr u -- addr' u' ) [: .net2o-cache$ $. '/' emit type ;] $tmp ;
: ~net2o-cache/ ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop set-dir throw ;
: ~net2o-cache/.. ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop dirname set-dir throw ;

  close all files
* $2B set-top ( utop flag -- )
  set top, flag is true when all data is sent
* $2C slurp ( -- )
  slurp in tracked files
* $2D ack-reset ( -- )
  reset ack state
* $2E slurped ( $slurped -- )
  respond to slurped stuff

### file commands ###

* $30 file-id ( uid -- o:file )
  choose a file object
* $20 open-file ( $:string mode -- )
  open file with mode