# 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.7.2-20180607], [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])

	1 tries# +! tries# @ 0 <# #s #> pw-num >o to text$ o>
	keys sec[]free
	drop nip 0 tuck false
	1e o ['] shake-lr >animate
	1 tries# @ lshift s>f f2/ pw-err ['] err-fade >animate
    ELSE
	0 >o 0 secret-key init-client >raw-key
	read-chatgroups announce-me o>
	\ ." Right passphrase" cr
	show-nicks
	true
    THEN ;

: 20%bt ( o -- o ) >o font-size# 20% f* to bordert o o> ;
: 25%b ( o -- o ) >o font-size# 25% f* to border o o> ;

0 Value groups-box
0 Value nicks-box
0 Value msgs-box
0 Value msg-box
0 Value msg-vbox

0 Value group-name
0 Value group-members

htab-glue new tab-glue: name-tab
htab-glue new tab-glue: pk-tab
htab-glue new tab-glue: group-tab
htab-glue new tab-glue: chatname-tab

[IFUNDEF] child+

	I @ .show-nick
    cell +LOOP ;

: refresh-top ( -- )
    +sync +lang
    top-widget >o htop-resize  <draw-init draw-init draw-init> htop-resize o> ;

: gui-chat-connects ( -- )
    chat-keys [: key>group
	2dup search-connect ?dup-IF  >o +group greet o> 2drop  EXIT  THEN
	2dup pk-peek? IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;

: group[] ( box group -- box )
    [:  top-widget >r
	data $@ group-name >o to text$ o>
	data cell+ $@ drop cell+ >o groups:id$ groups:member[] o>
	[: [: 2over type '@' emit type ;] $tmp chat-keys $+[]! ;] $[]map
	gui-msgs chat-frame to top-widget refresh-top
	gui-chat-connects
	widgets-loop \ connection .send-leave
	r> to top-widget +sync +config
    ;] swap click[] ;

: show-group ( last# -- )
    dup { g -- } cell+ $@ drop cell+ >o
    {{ glue*l $CCAA44FF slide-frame dup .button1
	{{
	    {{ \large blackish

wmsg-class ' new static-a with-allocater Constant wmsg-o
wmsg-o >o msg-table @ token-table ! o>

: wmsg-display ( addr u -- )
    !date wmsg-o .msg-display ;

#128 Value gui-msgs# \ display last 128 messages

: gui-msgs ( gaddr u -- )
    -1 to last-day
    -1 to last-hour
    -1 to last-minute
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+

	{{
	    glue*l $000000FF slide-frame dup .button1
	    {{
		\large whitish
		"⬅" }}text 40%b [: -1 level# +! ;] over click[]
		!i18n l" Chat Log" }}text' !lit 40%b
		"" }}text 40%b dup to group-name
		{{
		}}h box[] dup to group-members
		glue*l }}glue
	    }}h box[]
	}}z box[]
	{{
	    {{
		{{
		tex: vp-chats vp-chats glue*lll ' vp-chats }}vp vp[]

    connect( [: .time ." Connect to: " dup hex. cr ;] $err )
    net2o:new-context >o rdrop o to connection  setup!
    dest-pk \ set our destination key
    +resend-cmd net2o:connect
    +flow-control +resend
    connect( [: .time ." Connected, o=" o hex. cr ;] $err ) ;

0 Value dht-connection

Forward renat-all

event: :>renat ( -- )  renat-all ;
: dht-beacon <event :>renat main-up@ event> 2drop ;

: dht-connect ( -- )
    dht-connection ?dup-IF  >o o to connection rdrop  EXIT  THEN
    $8 $8 dhtnick $@ nick>pk dhtroot
    beacons @ 0= IF  return-addr be@ ['] dht-beacon 0 .add-beacon  THEN
    pk:connect  o to dht-connection ;
: dht-disconnect ( -- )
    0 addr dht-connection !@  ?dup-IF  .disconnect-me  THEN ;

Variable announced
: subme ( -- )  announced @ IF
	dht-connect sub-me THEN ;

: c:disconnect ( -- ) connect( [: ." Disconnecting..." cr ;] $err )
    disconnect-me connect( [: .packets profile( .times ) ;] $err ) ;

: c:fetch-id ( pubkey u -- )
    net2o-code
      expect-reply  fetch-id,

      cell +LOOP
    ;] #map ;

\ notification for address changes

true Value connected?




[IFDEF] android     require android/net.fs  [ELSE]
    [IFDEF] PF_NETLINK  require linux/net.fs    [THEN]
[THEN]

\ announce and renat




: announce-me ( -- )
    tick-adjust 64@ 64-0= IF  +get-time  THEN



    dht-connect replace-me -other  announced on ;

: renat-all ( -- ) beacon( ." remove all beacons" cr )
    [IFDEF] renat-complete [: [THEN]
    beacons #offs !my-addr announce-me renat
    [IFDEF] renat-complete ;] catch renat-complete throw [THEN]
    beacon( ." done renat" cr ) ;

	2dup d0<> WHILE
	    over c@ '!' = WHILE
		replace-key o>
		connect( >o ke-pk $@ ." replace key: " 2dup 85type cr o o> )
		>r 2dup c:fetch-id r> >o  REPEAT  THEN  d0<> ;

: pk-query ( addr u xt -- flag ) >r
    dht-connect  2dup r> execute  replace-loop ;

: pk-lookup ( addr u -- )
    ['] pk:fetch-host  ['] pk:addme-fetch-host  announced @ select
    pk-query 0= !!host-notfound!! ;

: pk-peek? ( pk u -- flag )  ['] pk:fetch-host pk-query ;

User hostc$ \ check for this hostname

: check-host? ( o addr u -- o addr' u flag )
    2 pick .host>$ ;

0 Value ?myself

: myhost= ( o -- flag )
    .host:id $@ host$ $@ str= ?myself and ;
    
: host= ( o -- flag )
    >o hostc$ $@ dup IF  host:id $@ str=  ELSE  2drop true  THEN  o> ;

: 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
      connect( ." insert host: " temp-addr .addr-path cr )
      ret-addr $10 0 skip nip 0= IF
	  temp-addr ret-addr $10 move
      THEN  !0key  drop true ;] addr>sock ;

: insert-addr$ ( addr u -- flag )  dest-0key dest-0key> !
    new-addr dup insert-addr swap .net2o:dispose-addr ;

: insert-host ( addr u -- flag )  dest-0key dest-0key> !
    new-addr  dup host=  over myhost= 0= and  IF
	msg( ." insert: " dup .host:id $@ type cr )
	dup insert-addr  ELSE  false  THEN
    swap .net2o:dispose-addr ;

: insert-host? ( flag o addr u -- flag' o )
    3 pick IF  2drop  EXIT  THEN
    check-host? IF  insert-host  ELSE  2drop false  THEN
    rot or swap ;

: make-context ( pk u -- )
    ret0 net2o:new-context >o rdrop dest-pk ;

in net2o : pklookup ( pkaddr u -- )
    2dup keysize2 safe/string hostc$ $! key2| 2dup pkc over str= to ?myself
    2dup >d#id { id }
    id .dht-host $[]# 0= IF  2dup pk-lookup  2dup >d#id to id  THEN
    2dup make-context
    false id dup .dht-host ['] insert-host? $[]map drop
    0= !!no-address!!  2drop ;

: ?nat-done ( n -- )

User search-key[]
User pings[]

: search-keys ( -- )
    dht-connect
    net2o-code  expect-reply
    search-key[] [: $, dht-id dht-owner? end-with ;] $[]map
    cookie+request end-code| ;

: search-addrs ( -- )
    dht-connect
    net2o-code  expect-reply
    search-key[] [: $, dht-id dht-host? end-with ;] $[]map
    cookie+request end-code| ;

: insert-keys ( -- )
    defaultkey @ >storekey !
    import#dht import-type !
    search-key[] [: >d#id >o
      0 dht-owner $[]@ nip sigsize# u> IF
	  64#-1 key-read-offset 64!

    ?get-me ['] hash-out arg-loop ;

\ others

: bye ( -- )
    \U bye
    \G bye: quit command mode and terminate program
    subme dht-disconnect bye ;

: -bw ( -- )
    \O -bw
    \G -bw: disable color codes
    ['] drop is attr!  next-cmd ;

: -yes ( -- )