# 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-20200514], [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])

# 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-20200521], [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])

    [:  current-player @ ?dup-IF
	    caller-w <> IF
		play$ $@ current-player @ >o to text$ o> +sync
	    THEN
	THEN
	caller-w .text$ play$ $@ str=
	IF
	    addr data $@ >msg-audio-player
	    pause$ $@ caller-w >o to text$ o> +sync

	ELSE
	    pause-play
	    play$ $@ caller-w >o to text$ o> +sync
	THEN  ;]
    2swap $make 64#1 +to msg:timestamp click[] ;

:noname ( addr u type -- )

    [:  current-player @ ?dup-IF
	    caller-w <> IF
		play$ $@ current-player @ >o to text$ o> +sync
	    THEN
	THEN
	caller-w .text$ play$ $@ str=
	IF
	    addr data $@ ['] >msg-audio-player catch 0= IF
		pause$ $@ caller-w >o to text$ o> +sync
	    ELSE  2drop  THEN
	ELSE
	    pause-play
	    play$ $@ caller-w >o to text$ o> +sync
	THEN  ;]
    2swap $make 64#1 +to msg:timestamp click[] ;

:noname ( addr u type -- )

	    bounds ?DO
		I @ to msg-group-o 0 .(avalanche-msg)
	    cell +LOOP
	ELSE  2drop  THEN  cleanup-msg ;] catch
    r> to msg-group-o throw ;

: 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 -- )
    0 .pk.host 2over  msg:ihave  >send-have ;

: push-msg ( o:parent -- )
    up@ receiver-task <> IF
	avalanche-msg
    ELSE wait-task @ ?dup-IF
	    <event >r o elit, msg-group-o elit,
	    :>avalanche r> event>
................................................................................
event: :>queued ( queue -- )
    0 fetch-queue[] !@ queue? off transmit-queue ;
: enqueue ( -- )
    -1 queue? !@ 0= IF  <event :>queued up@ event>  THEN ;

forward need-hashed?
: >have-group ( addr u -- )

    msg-group-o { w^ grp }
    2dup have-group# #@ nip IF
	grp last# cell+ +unique$
    ELSE
	grp cell 2swap have-group# #!
    THEN ;

: >fetch-queue ( addr u -- )
    2dup need-hashed? IF
	fetch-queue[] $ins[] drop
    ELSE  >ihave  THEN ;
: ?fetch ( addr u -- )
    key| 2dup >have-group >fetch-queue ;
................................................................................
also net2o-base
\ chain messages to one previous message
: chain, ( msgaddr u -- )
    [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;
: ihave, ( -- )
    ihave$ $@ dup IF
	maxstring over 4 + - mehave$ $@len - dup 0< IF  2drop  EXIT  THEN
	drop keysize negate and dup >r
	$, mehave$ $@ $, msg-ihave
	ihave$ 0 r> $del
    ELSE  2drop  THEN ;
: push, ( -- )
    push$ $@ dup IF  $, nestsig  ELSE  2drop  THEN ;

: (send-avalanche) ( xt -- addr u flag )
    [: 0 >o [: <msg msg-start execute msg> ihave, ;] gen-cmd$ o>
      +last-signed msg-log, ;] [group] ;
previous

: send-avalanche ( xt -- )
    msg-group-o .msg:?otr IF  now>otr  ELSE  now>never  THEN
    (send-avalanche)
    >r .chat r> 0= IF  msg-group-o .msg:.nobody  THEN ;

................................................................................
      remote-host$ $. ." @" pubkey $@ .simple-id ." :" forth:cr
	true ;] search-context ; is /connections

:noname ( addr u -- )  2drop enqueue ; is /fetch

:noname ( addr u -- )  2drop
    ." Want:" forth:cr
    fetch>want { w^ want# }
    want# [: { item }

	." from " item $@ .@host.id ."  want " item cell+ $@ 85type forth:cr








    ;] #map
    want# #frees ; is /want
}scope

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

Defer chat-cmd-file-execute
' execute is chat-cmd-file-execute
................................................................................
    ELSE  2drop rectype-null  THEN ;

forward hash-in

: jpeg? ( addr u -- flag )
    dup 4 - 0 max safe/string ".jpg" str= ;




: file-in ( addr u -- hash u )
    slurp-file over >r hash-in r> free throw 2dup key| >ihave ;

: img-rec ( addr u -- .. token )
    2dup "img:" string-prefix? IF
	over ?flush-text
	[:  2dup + >r
	    4 /string save-mem over >r 2dup jpeg? IF
		2dup >thumbnail
		dup IF  over >r hash-in
		    [: forth:type img-orient @ 1- 0 max forth:emit ;] $tmp
		    r> free throw  THEN
	    ELSE  #0.  THEN
	    2swap file-in
	    2swap dup IF   2dup key| >ihave  THEN
	    [:  dup IF  $, msg:thumbnail# ulit, msg-object  ELSE  2drop  THEN
		$, msg:image# ulit, msg-object ;]
	    r> free throw  r> to last->in ;]
	catch 0= IF  rectype-name  EXIT  THEN  THEN
    2drop rectype-null ;
: audio-rec ( addr u -- .. token )
    2dup "audio:" string-prefix? IF

	    bounds ?DO
		I @ to msg-group-o 0 .(avalanche-msg)
	    cell +LOOP
	ELSE  2drop  THEN  cleanup-msg ;] catch
    r> to msg-group-o throw ;

: msg:ihave ( id u1 hash u2 -- )
    fetch( ." ihave:" 2over .@host.id 2dup bounds U+DO
    forth:cr I keysize 85type keysize +LOOP forth:cr )
    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 -- )
    0 .pk.host 2over  msg:ihave  2drop ( >send-have ) ;

: push-msg ( o:parent -- )
    up@ receiver-task <> IF
	avalanche-msg
    ELSE wait-task @ ?dup-IF
	    <event >r o elit, msg-group-o elit,
	    :>avalanche r> event>
................................................................................
event: :>queued ( queue -- )
    0 fetch-queue[] !@ queue? off transmit-queue ;
: enqueue ( -- )
    -1 queue? !@ 0= IF  <event :>queued up@ event>  THEN ;

forward need-hashed?
: >have-group ( addr u -- )
    last# >r
    msg-group-o { w^ grp }
    2dup have-group# #@ nip IF
	grp last# cell+ +unique$  2drop
    ELSE
	grp cell 2swap have-group# #!
    THEN  r> to last# ;

: >fetch-queue ( addr u -- )
    2dup need-hashed? IF
	fetch-queue[] $ins[] drop
    ELSE  >ihave  THEN ;
: ?fetch ( addr u -- )
    key| 2dup >have-group >fetch-queue ;
................................................................................
also net2o-base
\ chain messages to one previous message
: chain, ( msgaddr u -- )
    [: 2dup startdate@ 64#0 { 64^ sd } sd le-64!  sd 1 64s forth:type
	c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ;
: ihave, ( -- )
    ihave$ $@ dup IF


	$, mehave$ $@ $, msg-ihave

    ELSE  2drop  THEN ;
: push, ( -- )
    push$ $@ dup IF  $, nestsig  ELSE  2drop  THEN ;

: (send-avalanche) ( xt -- addr u flag )
    [:  0 >o [: <msg msg-start execute msg> ;] gen-cmd$ o>
	+last-signed msg-log, ;] [group] ;
previous

: send-avalanche ( xt -- )
    msg-group-o .msg:?otr IF  now>otr  ELSE  now>never  THEN
    (send-avalanche)
    >r .chat r> 0= IF  msg-group-o .msg:.nobody  THEN ;

................................................................................
      remote-host$ $. ." @" pubkey $@ .simple-id ." :" forth:cr
	true ;] search-context ; is /connections

:noname ( addr u -- )  2drop enqueue ; is /fetch

:noname ( addr u -- )  2drop
    ." Want:" forth:cr

    fetch# [: { item }
	." hash: " item $@ 85type space
	case item cell+ $@ drop cell+ .fetcher:state
	    0 of  ." want from"
		item $@ have# #@ bounds U+DO
		    forth:cr I @ .@host.id
		cell +LOOP
	    endof
	    1 of  ." fetching..."  endof
	    2 of  ." got it"  endof
	endcase forth:cr
    ;] #map ; is /want

}scope

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

Defer chat-cmd-file-execute
' execute is chat-cmd-file-execute
................................................................................
    ELSE  2drop rectype-null  THEN ;

forward hash-in

: jpeg? ( addr u -- flag )
    dup 4 - 0 max safe/string ".jpg" str= ;

: >have+group ( addr u -- addr u )
    2dup key|  2dup >have-group  >ihave ;

: file-in ( addr u -- hash u )
    slurp-file over >r hash-in r> free throw >have+group ;

: img-rec ( addr u -- .. token )
    2dup "img:" string-prefix? IF
	over ?flush-text
	[:  2dup + >r
	    4 /string save-mem over >r 2dup jpeg? IF
		2dup >thumbnail
		dup IF  over >r hash-in
		    [: forth:type img-orient @ 1- 0 max forth:emit ;] $tmp
		    r> free throw  THEN
	    ELSE  #0.  THEN
	    2swap file-in
	    2swap dup IF   >have+group  THEN
	    [:  dup IF  $, msg:thumbnail# ulit, msg-object  ELSE  2drop  THEN
		$, msg:image# ulit, msg-object ;]
	    r> free throw  r> to last->in ;]
	catch 0= IF  rectype-name  EXIT  THEN  THEN
    2drop rectype-null ;
: audio-rec ( addr u -- .. token )
    2dup "audio:" string-prefix? IF

# Commands #

Version 0.9.7-20200514.

net2o separates data and commands.  Data is passed through to higher
layers, commands are interpreted when they arrive.  For connection
requests, a special bit is set, and the address then isn't used as
address, but as IV for the opportunistic encoding.

The command interpreter is a stack machine with two data types: 64

# Commands #

Version 0.9.7-20200521.

net2o separates data and commands.  Data is passed through to higher
layers, commands are interpreted when they arrive.  For connection
requests, a special bit is set, and the address then isn't used as
address, but as IV for the opportunistic encoding.

The command interpreter is a stack machine with two data types: 64