--
--	game-ttysocket.occ -- telnet style interface for the game (best done with `tf' or similar)
--	Copyright (C) 2004 Fred Barnes <frmb@kent.ac.uk>
--
--	This program is free software; you can redistribute it and/or modify
--	it under the terms of the GNU General Public License as published by
--	the Free Software Foundation; either version 2 of the License, or
--	(at your option) any later version.
--
--	This program 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 General Public License for more details.
--
--	You should have received a copy of the GNU General Public License
--	along with this program; if not, write to the Free Software
--	Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
--

#INCLUDE "types.inc"
#INCLUDE "config.inc"
#INCLUDE "course.module"

#INCLUDE "file.module"
#INCLUDE "sock.module"

#USE "game-utils"
#USE "game-client"
#USE "game-tty"

--{{{  PROC tcp.buf.reader (CHAN BOOL in?, CHAN MOBILE []BYTE out!, SOCKET sock)
-- reads lines from a socket.  if an error occurs, it outputs the special
-- string DIEMESSAGE
PROC tcp.buf.reader (CHAN BOOL in?, CHAN MOBILE []BYTE out!, SOCKET sock)
  [512]BYTE buf:
  INT start, stop:
  SEQ
    start := 0
    stop := 0
    INITIAL BOOL running IS TRUE:
    WHILE running
      INT res:
      SEQ
        socket.read (sock, [buf FROM stop], 511 - stop, res)
        -- poll termination
        PRI ALT
          BOOL any:
          in ? any
            running := FALSE
          TRUE & SKIP
            SKIP
        IF
          NOT running
            SKIP
          res <= 0
            SEQ
              running := FALSE
              out ! ##DIEMESSAGE
          TRUE
            INT idx:
            SEQ
              stop := stop + res
              -- any whole lines ?
              idx := 0
              WHILE idx < stop
                IF
                  (buf[idx] = #0A) OR (buf[idx] = #0D)
                    INITIAL BYTE ch IS buf[idx]:
                    SEQ
                      IF
                        idx > 0
                          SEQ
                            -- have a line, output it and shuffle up
                            out ! [buf FOR idx]
                        TRUE
                          SKIP  -- blank line
                      idx := idx + 1
                      WHILE (idx < stop) AND (((buf[idx] = #0D) OR (buf[idx] = #0A)) AND (buf[idx] <> ch))
                        idx := idx + 1
                      IF
                        stop > idx
                          SEQ
                            SEQ j = 0 FOR (stop - idx)
                              buf[j] := buf[j + idx]
                            stop := stop - idx
                        TRUE
                          stop := 0         -- only had one line
                      idx := 0
                  TRUE
                    idx := idx + 1
              IF
                stop > 510
                  -- too much..!
                  stop := 0
                TRUE
                  SKIP
:
--}}}
--{{{  PROC tcp.buf.writer (CHAN MOBILE []BYTE in?, CHAN BOOL out!, SOCKET sock)
PROC tcp.buf.writer (CHAN MOBILE []BYTE in?, CHAN BOOL out!, SOCKET sock)
  INITIAL BOOL running IS TRUE:
  WHILE running
    INT res:
    MOBILE []BYTE str:
    INT olen:
    SEQ
      in ? str
      IF
        (SIZE str) = 0
          SEQ
            olen := 2
            socket.fullwrite (sock, "*#0D*#0A", res)
        TRUE
          [256]BYTE obuf:
          SEQ
            olen := 0
            buffer.set.string (obuf, olen, str)
            buffer.set.string (obuf, olen, "*#0D*#0A")
            socket.fullwrite (sock, [obuf FOR olen], res)
      IF
        res <> olen
          SEQ
            out ! FALSE
            running := FALSE
        TRUE
          out ! TRUE
:
--}}}
--{{{  PROC safe.write.tcp (CHAN MOBILE []BYTE out!, CHAN BOOL in?, VAL []BYTE string, BOOL ok)
PROC safe.write.tcp (CHAN MOBILE []BYTE out!, CHAN BOOL in?, VAL []BYTE string, BOOL ok)
  IF
    NOT ok
      SKIP
    TRUE
      BOOL b:
      SEQ
        out ! string
        in ? ok
:
--}}}
--{{{  PROC telnet.client.start (SHARED CHAN SOCKET in?, SHARED CT.GAMECTRL! to.game)
PROC telnet.client.start (SHARED CHAN SOCKET in?, SHARED CT.GAMECTRL! to.game, SHARED CT.LINCLINK! to.linc)
  SOCKET cli, cli2, cli3:
  SEQ
    CLAIM in?
      in ? cli

    INT lres:
    socket.setsockopt (cli, SOL.TCP, TCP.NODELAY, 1, lres)
    
    cli2 := cli
    cli3 := cli

    CHAN MOBILE []BYTE to.tcp, from.tcp:
    CHAN BOOL to.read, from.write:
    PAR
      tcp.buf.reader (to.read?, from.tcp!, cli)
      tcp.buf.writer (to.tcp?, from.write!, cli2)
      --{{{  initial local handling
      BOOL ok:
      MOBILE []BYTE uname:
      SEQ
        ok := TRUE
        uname := ##DIEMESSAGE
        INITIAL BOOL looping IS TRUE:
        WHILE looping
          SEQ
            safe.write.tcp (to.tcp!, from.write?, "", ok)
            safe.write.tcp (to.tcp!, from.write?, "welcome to the game!", ok)
            safe.write.tcp (to.tcp!, from.write?, "enter a username", ok)
            from.tcp ? uname
            IF
              (uname = ##DIEMESSAGE)
                --{{{  disconnecting or something
                SEQ
                  to.read ! FALSE
                  looping := FALSE
                --}}}
              TRUE
                --{{{  try and register
                SEQ
                  safe.write.tcp (to.tcp!, from.write?, "registering..", ok)
                  CLAIM to.game
                    SEQ
                      to.game[in] ! register.name; CLONE uname
                      to.game[out] ? CASE
                        name.in.use
                          SKIP
                        ok
                          looping := FALSE
                  IF
                    looping
                      safe.write.tcp (to.tcp!, from.write?, "name in use.  try another.", ok)
                    TRUE
                      SKIP
                --}}}
        -- maybe registered
        IF
          NOT ok
            SKIP
          (uname = ##DIEMESSAGE)
            SKIP
          TRUE
            --{{{  oki, start client.
            IO.LINK? io.svr:
            IO.LINK! io.cli:
            SEQ
              io.svr, io.cli := MOBILE IO.LINK
              FORK tty.client.if (uname, io.cli, to.game, to.linc, FALSE)
              CHAN BOOL l1, l2:
              PAR
                INITIAL BOOL running IS TRUE:
                WHILE running
                  MOBILE []BYTE msg:
                  PRI ALT
                    BOOL any:
                    l2 ? any
                      SEQ
                        running := FALSE
                        l1 ! TRUE
                    from.tcp ? msg
                      IF
                        msg = ##DIEMESSAGE
                          SEQ
                            io.svr[out] ! "logout"
                        TRUE
                          io.svr[out] ! msg
                INITIAL BOOL running IS TRUE:
                WHILE running
                  MOBILE []BYTE msg:
                  PRI ALT
                    BOOL any:
                    l1 ? any
                      SEQ
                        running := FALSE
                        l2 ! TRUE
                    io.svr[in] ? msg
                      IF
                        msg = ##DIEMESSAGE
                          SEQ
                            INT res:
                            socket.shutdown (cli3, SHUT.RDWR, res)
                            running := FALSE
                            PAR
                              BOOL any:
                              l1 ? any
                              l2 ! TRUE
                        TRUE
                          BOOL any:
                          SEQ
                            to.tcp ! msg
                            from.write ? any
                            IF
                              NOT any
                                SEQ
                                  running := FALSE
                                  PAR
                                    BOOL any:
                                    l1 ? any
                                    l2 ! TRUE
                              TRUE
                                SKIP
            --}}}
      --}}}
:
--}}}
--{{{  PROC telnet.main.server (SHARED CT.GAMECTRL! to.game, SHARED CT.LINCLINK! to.linc, SOCKET sock)
PROC telnet.main.server (SHARED CT.GAMECTRL! to.game, SHARED CT.LINCLINK! to.linc, SOCKET sock)
  SOCKET client:
  INT result:
  INITIAL BOOL running IS TRUE:
  WHILE running
    SEQ
      socket.accept (sock, client, result)
      IF
        result < 0
          SEQ
            CLAIM to.game
              to.game[in] ! debug; "telnet.main.server: failed to accept.  shutting down."
            running := FALSE
        TRUE
          -- accepted connection, start handling process
          SHARED? CHAN SOCKET sock.in:
          SEQ
            FORK telnet.client.start (sock.in?, to.game, to.linc)
            sock.in ! client
:
--}}}
--{{{  PROC telnet.server (VAL []BYTE host, VAL INT port, SHARED CT.GAMECTRL! to.game, SHARED CT.LINCLINK! to.linc)
PROC telnet.server (VAL []BYTE host, VAL INT port, SHARED CT.GAMECTRL! to.game, SHARED CT.LINCLINK! to.linc)
  SOCKET svr.sock:
  INT addr, res:
  SEQ
    socket.addr.of.host (host, addr, res)
    IF
      res < 0
        CLAIM to.game
          to.game[in] ! debug; "telnet.server: cannot resolve hostname, giving up."
      TRUE
        SEQ
          socket.create.listen.tcp (svr.sock, addr, port, res)
          INT lres:
          socket.setsockopt (svr.sock, SOL.SOCKET, SO.REUSEADDR, 1, lres)
          IF
            res < 0
              CLAIM to.game
                to.game[in] ! debug; "telnet.server: cannot create listening socket, giving up."
            TRUE
              SEQ
                telnet.main.server (to.game, to.linc, svr.sock)
                socket.close (svr.sock)
:
--}}}

