--
--	Trap: an asynchronous network messaging system for occam-pi
--	Copyright (C) 2008, 2009 Adam Sampson <ats@offog.org>
--
--	This library is free software; you can redistribute it and/or
--	modify it under the terms of the GNU Lesser General Public
--	License as published by the Free Software Foundation, either
--	version 2 of the License, or (at your option) any later version.
--
--	This library is distributed in the hope that it will be useful,
--	but WITHOUT ANY WARRANTY; without even the implied warranty of
--	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--	Lesser General Public License for more details.
--
--	You should have received a copy of the GNU Lesser General Public
--	License along with this library.  If not, see
--	<http://www.gnu.org/licenses/>.
--

--** @module trap

#INCLUDE "file.module"
#INCLUDE "sock.module"
#INCLUDE "useful.module"
#INCLUDE "selector.module"

#INCLUDE "trap.inc"

--{{{  internal types
DATA TYPE PACKET.HEADER
  PACKED RECORD
    INT port:
    INT size:
:

PROTOCOL DATA.IN IS PACKET.HEADER; MOBILE []BYTE:

CHAN TYPE OUTBOUND
  MOBILE RECORD
    CHAN DATA.IN req?:
:
--}}}

--{{{  PROC trap.check
--* Check that a condition holds; if not, print the message and die.
-- This is essentially a slightly more user-friendly [@ref ASSERT].
-- @private
PROC trap.check (VAL BOOL cond, VAL []BYTE message)
  IF
    cond
      SKIP
    TRUE
      SEQ
        trace.ssn ("trap: fatal error: ", message)
        CAUSEERROR ()
:
--}}}
--{{{  PROC trap.bind.socket
PROC trap.bind.socket (SOCKET listen)
  INT result:
  SEQ
    socket.create.tcp (listen)
    trap.check (listen[fd] <> (-1), "could not open listen socket")
    socket.setsockopt (listen, SOL.SOCKET, SO.REUSEADDR, 1, result)
    trap.check (result = 0, "could not set socket options")
    socket.bind (listen, result)
    trap.check (result = 0, "could not bind socket")
    socket.listen (listen, 32, result)
    trap.check (result = 0, "could not listen on socket")
:
--}}}
--{{{  PROC trap.server
PROC trap.server (VAL INT node, TRAP.CT? svr)
  --{{{  PROC outbound
  PROC outbound (SHARED SELECTOR.CT! sel, VAL SOCKET sock.v, OUTBOUND? svr)
    INITIAL SOCKET sock IS sock.v:
    SEQ
      selector.make.nonblocking (sock[fd])

      SHARED! CHAN SELECTOR.SIGNAL? new.sock.svr:
      SELECTOR.SIGNAL? sock.svr:
      INITIAL BOOL want.svr IS FALSE:
      INITIAL BOOL got.svr IS FALSE:

      INITIAL MOBILE []BYTE buf IS MOBILE [65536]BYTE:
      INITIAL INT used IS 0:

      PROC add.to.buf (VAL []BYTE s)
        SEQ
          IF
            (used + (SIZE s)) > (SIZE buf)
              RESIZE.MOBILE.ARRAY.1D (buf, 2 * (used + (SIZE s)))
            TRUE
              SKIP
          [buf FROM used FOR (SIZE s)] := s
          used := used + (SIZE s)

          IF
            (NOT want.svr) AND (used > 0)
              --{{{  start selecting
              SEQ
                want.svr := TRUE
                FORK selector.delayed.add (sel, sock[fd], SELECT.WRITE, new.sock.svr!)
              --}}}
            TRUE
              SKIP
      :

      INITIAL BOOL running IS TRUE:
      WHILE running
        ALT
          PACKET.HEADER header:
          MOBILE []BYTE data:
          svr[req] ? header; data
            --{{{
            SEQ
              VAL []BYTE s RETYPES header:
              add.to.buf (s)
              add.to.buf (data)
            --}}}

          (NOT got.svr) & new.sock.svr ? sock.svr
            got.svr := TRUE

          got.svr & sock.svr[signal] ? CASE
            ready
              --{{{
              INT sent:
              SEQ
                file.write (sock[fd], [buf FOR used], sent)
                trap.check (sent >= 0, "socket write failed")

                used := used - sent
                SEQ i = 0 FOR used
                  buf[i] := buf[i + sent]

                IF
                  used = 0
                    SEQ
                      want.svr, got.svr := FALSE, FALSE
                      sock.svr[ack] ! remove
                  TRUE
                    sock.svr[ack] ! again
              --}}}

      socket.close (sock)
  :
  --}}}
  --{{{  PROC inbound
  PROC inbound (SHARED SELECTOR.CT! sel, VAL SOCKET sock.v, SHARED CHAN DATA.IN data.in!)
    VAL INT BH IS BYTESIN (PACKET.HEADER):

    INITIAL SOCKET sock IS sock.v:
    SELECTOR.SIGNAL? sock.svr:
    SEQ
      selector.make.nonblocking (sock[fd])
      selector.add (sel, sock[fd], SELECT.READ, sock.svr)

      INITIAL MOBILE []BYTE buf IS MOBILE [512]BYTE:
      INITIAL INT used IS 0:
      INITIAL BOOL running IS TRUE:
      WHILE running
        INT result:
        SEQ
          sock.svr[signal] ? CASE ready

          --{{{  stretch buf
          IF
            (used + 4096) > (SIZE buf)
              RESIZE.MOBILE.ARRAY.1D (buf, 2 * ((SIZE buf) + 4096))
            TRUE
              SKIP
          --}}}

          file.read (sock[fd], [buf FROM used], result)
          used := used + result
          IF
            result <= 0
              running := FALSE
            TRUE
              --{{{  unpack any packets we've received
              INITIAL BOOL unpacking IS TRUE:
              WHILE unpacking
                IF
                  used < BH
                    --{{{  run out of data
                    unpacking := FALSE
                    --}}}
                  TRUE
                    PACKET.HEADER header:
                    SEQ
                      VAL PACKET.HEADER h RETYPES [buf FOR BH]:
                      header := h
                      IF
                        (used - BH) >= header[size]
                          --{{{  got a packet!
                          -- FIXME: This copies too much; it should
                          -- extract all the packets then move down.
                          MOBILE []BYTE data:
                          VAL INT movedown IS BH + header[size]:
                          SEQ
                            data := MOBILE [header[size]]BYTE
                            [data FROM 0] := [buf FROM BH FOR header[size]]
                            CLAIM data.in!
                              data.in ! header; data
                            used := used - movedown
                            SEQ i = 0 FOR used
                              buf[i] := buf[i + movedown]
                          --}}}
                        TRUE
                          --{{{  run out of data
                          unpacking := FALSE
                          --}}}
              --}}}
            TRUE
              SKIP

          IF
            running
              sock.svr[ack] ! again
            TRUE
              sock.svr[ack] ! remove

      socket.close (sock)
  :
  --}}}
  --{{{  PROC accepter
  PROC accepter (SHARED SELECTOR.CT! sel, VAL SOCKET listen.v, SHARED CHAN DATA.IN data.in!)
    INITIAL SOCKET listen IS listen.v:
    SELECTOR.SIGNAL? listen.svr:
    SEQ
      selector.make.nonblocking (listen[fd])
      selector.add (sel, listen[fd], SELECT.READ, listen.svr)
      WHILE TRUE
        listen.svr[signal] ? CASE
          ready
            --{{{  accept new connection
            SOCKET sock:
            INT result:
            SEQ
              socket.accept (listen, sock, result)
              IF
                result <> (-1)
                  FORK inbound (sel, sock, data.in!)
                TRUE
                  SKIP
              listen.svr[ack] ! again
            --}}}
  :
  --}}}
  --{{{  PROC loopback
  PROC loopback (VAL INT after, VAL PACKET.HEADER header, MOBILE []BYTE data, SHARED CHAN DATA.IN data.in!)
    SEQ
      delay (after)
      CLAIM data.in!
        data.in ! header; data
  :
  --}}}

  INITIAL MOBILE []OUTBOUND! outbounds IS MOBILE [1]OUTBOUND!:
  INITIAL MOBILE []INT outbound.nodes IS MOBILE [1]INT:
  INITIAL INT num.outbounds IS 0:

  INITIAL MOBILE []TRAP.CHANNEL.CT! locals IS MOBILE [1]TRAP.CHANNEL.CT!:
  INITIAL MOBILE []INT local.ports IS MOBILE [1]INT:
  INITIAL INT num.locals IS 0:

  INT result:
  MOBILE []BYTE ns.host:
  INITIAL BOOL have.ns IS FALSE:
  SOCKET to.ns:
  SOCKET listen:
  SHARED SELECTOR.CT! sel:
  SHARED! CHAN DATA.IN data.in:
  SEQ
    --{{{  find nameserver
    INT fd:
    SEQ
      file.open (".trap.ns", O.RDONLY, fd)
      IF
        fd <> (-1)
          --{{{  read from file
          [256]BYTE buf:
          SEQ
            file.read (fd, buf, result)
            trap.check (result <> (-1), "read from .trap.ns failed")
            ns.host := [buf FOR result]
            rstrip.string (ns.host)
            file.close (fd, result)
          --}}}
        TRUE
          --{{{  not found
          ns.host := "localhost"
          --}}}
    --}}}
    --{{{  connect to nameserver
    INT addr:
    SEQ
      socket.addr.of.host (ns.host, addr, result)
      trap.check (result = 0, "could not look up nameserver name")
      socket.create.connect.tcp (to.ns, addr, TRAP.NS.PORT, result)
      IF
        result = 0
          have.ns := TRUE
        TRUE
          trace.sn ("trap: could not connect to nameserver; operating in standalone mode")
    --}}}
    --{{{  bind listen socket
    listen[local.addr] := INADDR.ANY
    listen[local.port] := 0
    trap.bind.socket (listen)
    socket.getsockname (listen, result)
    trap.check (result = 0, "getsockname on listen socket failed")
    --}}}
    --{{{  register with nameserver
    IF
      have.ns
        TRAP.NS.PACKET packet:
        SEQ
          packet[cmd] := 'r'
          packet[arg0] := node
          packet[arg1] := INT listen[local.port]
          VAL []BYTE buf RETYPES packet:
          SEQ
            socket.fullwrite (to.ns, buf, result)
            trap.check (result = (SIZE buf), "write to nameserver failed")
      TRUE
        SKIP
    --}}}
    selector.start (sel)
    FORK accepter (sel, listen, data.in!)
    WHILE TRUE
      ALT
        svr[req] ? CASE
          INT port:
          open; port
            --{{{
            TRAP.CHANNEL.CT? csvr:
            SEQ
              --{{{  stretch if necessary
              IF
                (num.locals + 1) >= (SIZE locals)
                  VAL INT new.size IS 2 * (num.locals + 1):
                  SEQ
                    RESIZE.MOBILE.ARRAY.1D (locals, new.size)
                    RESIZE.MOBILE.ARRAY.1D (local.ports, new.size)
                TRUE
                  SKIP
              --}}}
              csvr, locals[num.locals] := MOBILE TRAP.CHANNEL.CT
              local.ports[num.locals] := port
              num.locals := num.locals + 1
              svr[resp] ! opened; csvr
            --}}}
          INT dest.node, dest.port:
          MOBILE []BYTE data:
          send; dest.node; dest.port; data
            --{{{
            VAL PACKET.HEADER header IS [dest.port, SIZE data]:
            SEQ
              --{{{  find outbound
              IF
                dest.node = node
                  --{{{  sending to self
                  FORK loopback (0, header, data, data.in!)
                  --}}}
                IF i = 0 FOR num.outbounds
                  outbound.nodes[i] = dest.node
                    --{{{  found existing outbound
                    outbounds[i][req] ! header; data
                    --}}}
                NOT have.ns
                  trap.check (FALSE, "in standalone mode; cannot make outgoing connections")
                TRUE
                  --{{{  start new outbound
                  INT dest.addr, dest.tcpport:
                  SOCKET sock:
                  OUTBOUND? svr:
                  SEQ
                    --{{{  stretch if necessary
                    IF
                      (num.outbounds + 1) >= (SIZE outbounds)
                        VAL INT new.size IS 2 * (num.outbounds + 1):
                        SEQ
                          RESIZE.MOBILE.ARRAY.1D (outbounds, new.size)
                          RESIZE.MOBILE.ARRAY.1D (outbound.nodes, new.size)
                      TRUE
                        SKIP
                    --}}}
                    INITIAL BOOL connecting IS TRUE:
                    WHILE connecting
                      SEQ
                        --{{{  do nameserver lookup
                        INITIAL BOOL looking IS TRUE:
                        WHILE looking
                          TRAP.NS.PACKET packet:
                          SEQ
                            trace.sin ("doing nameserver lookup for ", dest.node)
                            --{{{  send request
                            packet[cmd] := 'l'
                            packet[arg0] := dest.node
                            packet[arg1] := 0
                            VAL []BYTE buf RETYPES packet:
                            SEQ
                              socket.fullwrite (to.ns, buf, result)
                              trap.check (result = (SIZE buf), "write to nameserver failed")
                            --}}}
                            --{{{  read response
                            []BYTE buf RETYPES packet:
                            SEQ
                              socket.fullread (to.ns, buf, SIZE buf, result)
                              trap.check (result = (SIZE buf), "read from nameserver failed")
                            CASE packet[cmd]
                              'y'
                                SEQ
                                  dest.addr, dest.tcpport := packet[arg0], packet[arg1]
                                  looking := FALSE
                              'n'
                                --{{{  not found; sleep and try again
                                delay (500000)
                                --}}}
                            --}}}
                        --}}}
                        --{{{  connect
                        trace.sin ("connecting to host ", dest.addr)
                        socket.create.connect.tcp (sock, dest.addr, dest.tcpport, result)
                        IF
                          result = 0
                            connecting := FALSE
                          TRUE
                            --{{{  failed; sleep and try again
                            delay (500000)
                            --}}}
                        --}}}
                    trace.sn ("connected")

                    outbounds[num.outbounds], svr := MOBILE OUTBOUND
                    outbound.nodes[num.outbounds] := dest.node

                    FORK outbound (sel, sock, svr)
                    outbounds[num.outbounds][req] ! header; data

                    num.outbounds := num.outbounds + 1
                  --}}}
              --}}}
            --}}}
        PACKET.HEADER header:
        MOBILE []BYTE data:
        data.in ? header; data
          --{{{
          IF
            IF i = 0 FOR num.locals
              local.ports[i] = header[port]
                locals[i][msg] ! data
            TRUE
              SEQ
                trace.sin ("retrying packet for unknown port ", header[port])
                FORK loopback (50000, header, data, data.in!)
          --}}}
:
--}}}
--{{{  PROC trap.start
--* Start the Trap server.
PROC trap.start (VAL INT node, RESULT SHARED TRAP.CT! control)
  TRAP.CT? svr:
  SEQ
    control, svr := MOBILE TRAP.CT
    FORK trap.server (node, svr)
:
--}}}
--{{{  PROC trap.open
--* Open a Trap port.
PROC trap.open (SHARED TRAP.CT! trap, VAL INT port,
                RESULT TRAP.CHANNEL.CT? chan)
  CLAIM trap
    SEQ
      trap[req] ! open; port
      trap[resp] ? CASE opened; chan
:
--}}}
--{{{  PROC trap.send
--* Send data to a Trap port.
PROC trap.send (SHARED TRAP.CT! trap, VAL INT node, port,
                MOBILE []BYTE data)
  PROC send (SHARED TRAP.CT! trap, VAL INT node, port, MOBILE []BYTE data)
    CLAIM trap
      trap[req] ! send; node; port; data
  :
  FORK send (trap, node, port, data)
:
--}}}
