--
--	ircplug.occ -- occam process to interface IRC protocol to a socket
--	Copyright (C) 2002 Fred Barnes <frmb2@ukc.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.
--

--{{{  includes, uses, etc.
#INCLUDE "socklib.inc"
#USE "sock.lib"
#INCLUDE "ircproto.inc"
--}}}  
--{{{  PROC ircplug.decode.out (SOCKET irc.socket, CHAN IRC.CS.PROTO in?, CHAN BOOL term?, con.req!)
PROC ircplug.decode.out (SOCKET irc.socket, CHAN IRC.CS.PROTO in?, CHAN BOOL term?, con.req!)

  PROC buffer.set.string ([]BYTE buffer, INT buf.len, VAL []BYTE str)
    SEQ
      [buffer FROM buf.len FOR (SIZE str)] := str
      buf.len := (buf.len + (SIZE str))
  :

  PROC num.to.bytes (VAL INT n, []BYTE buffer, INT len)
  -- Taken from utils.occ in the course library
    IF
      n = (MOSTNEG INT)
        [buffer FOR 11], len := "-2147483648", 11
      n = 0
        buffer[0], len := '0', 1
      TRUE
        INT x, i:
        VAL INT max.digits IS 20:
        [max.digits]INT D:
        SEQ
          IF
            n < 0
              x := (-n)
            TRUE
              x := n
          i := 0
          WHILE x > 0
            SEQ
              D[i] := (x \ 10)
              x := (x / 10)
              i := (i + 1)
          IF
            n < 0
              buffer[0], len := '-', 1
            TRUE
              len := 0
          #PRAGMA DEFINED D
          WHILE i > 0
            SEQ
              i := (i - 1)
              buffer[len] := BYTE (D[i] + (INT '0'))
              len := (len + 1)
  :

  PROC buffer.set.number ([]BYTE buffer, INT buf.len, VAL INT n)
    INT amt:
    SEQ
      num.to.bytes (n, [buffer FROM buf.len], amt)
      buf.len := (buf.len + amt)
  :

  VAL []BYTE CRLF IS "*#0D*#0A":
  INITIAL BOOL running IS TRUE:
  WHILE running
    INITIAL BOOL do.send IS FALSE:
    [MAX.MESSAGE.SIZE]BYTE buffer, buffer2, buffer3, buffer4:
    INT len:
    SEQ
      PRI ALT
        BOOL any:
        term ? any
          running := FALSE
        in ? CASE
          isconnected
            con.req ! TRUE
          --{{{  registration: pass, nick, user
          INT nl:
          pass; nl::[buffer FROM 5]
            SEQ
              [buffer FOR 5] := "PASS "
              len := nl + 5
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          INT nl, hops:
          nick; nl::[buffer FROM 5]; hops
            SEQ
              [buffer FOR 5] := "NICK "
              len := nl + 5
              IF
                hops > 0
                  SEQ
                    buffer.set.string (buffer, len, " ")
                    buffer.set.number (buffer, len, hops)
                TRUE
                  SKIP
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          INT ul, hl, sl, rl:
          user; ul::[buffer FROM 5]; hl::buffer2; sl::buffer3; rl::buffer4
            SEQ
              [buffer FOR 5] := "USER "
              len := ul + 5
              buffer.set.string (buffer, len, " ")
              buffer.set.string (buffer, len, [buffer2 FOR hl])
              buffer.set.string (buffer, len, " ")
              buffer.set.string (buffer, len, [buffer3 FOR sl])
              buffer.set.string (buffer, len, " :")
              buffer.set.string (buffer, len, [buffer4 FOR rl])
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          --}}}  
          --{{{  IRC operator: oper
          INT ul, pl:
          oper; ul::[buffer FROM 5]; pl::buffer2
            SEQ
              [buffer FOR 5] := "OPER "
              len := ul + 5
              buffer.set.string (buffer, len, " ")
              buffer.set.string (buffer, len, [buffer2 FOR pl])
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          --}}}  
          --{{{  messages: privmsg, notice
	  INT rl, ml:
	  privmsg; rl::[buffer FROM 8]; ml::[buffer2 FROM 2]
	    SEQ
	      [buffer FOR 8] := "PRIVMSG "
	      [buffer2 FOR 2] := " :"
	      len := rl + 8
	      IF
	        ml > 0
		  buffer.set.string (buffer, len, [buffer2 FOR (ml + 2)])
		TRUE
		  SKIP
	      buffer.set.string (buffer, len, CRLF)
	      do.send := TRUE
	  INT rl, ml:
	  notice; rl::[buffer FROM 7]; ml::[buffer2 FROM 1]
	    SEQ
	      [buffer FOR 7] := "NOTICE "
	      buffer2[0] := ' '
	      len := rl + 7
	      IF
	        ml > 0
		  buffer.set.string (buffer, len, [buffer2 FOR (ml + 1)])
		TRUE
		  SKIP
	      buffer.set.string (buffer, len, CRLF)
	      do.send := TRUE
	  --}}}
          --{{{  channel stuff: join, part
          INT cl, kl:
          join; cl::[buffer FROM 5]; kl::buffer2
            SEQ
              [buffer FOR 5] := "JOIN "
              len := cl + 5
              IF
                kl > 0
                  SEQ
                    buffer.set.string (buffer, len, " ")
                    buffer.set.string (buffer, len, [buffer2 FOR kl])
                TRUE
                  SKIP
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          INT cl:
          part; cl::[buffer FROM 5]
            SEQ
              [buffer FOR 5] := "PART "
              len := cl + 5
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          --}}}  
          --{{{  miscellaneous: pong
          INT al, bl:
          pong; al::[buffer FROM 5]; bl::buffer2
            SEQ
              [buffer FOR 5] := "PONG "
              len := al + 5
              IF
                bl > 0
                  SEQ
                    buffer.set.string (buffer, len, " ")
                    buffer.set.string (buffer, len, [buffer2 FOR bl])
                TRUE
                  SKIP
              buffer.set.string (buffer, len, CRLF)
              do.send := TRUE
          --}}}  
      IF
        do.send
          #PRAGMA DEFINED buffer, len
          INT r:
          socket.fullwrite (irc.socket, [buffer FOR len], r)
        TRUE
          SKIP
:
--}}}  
--{{{  PROC ircplug.decode.in2 (CHAN ICB in?, CHAN IRC.SC.PROTO out!, CHAN BOOL term.in?, term.out!, con.req?)
PROC ircplug.decode.in2 (CHAN ICB in?, CHAN IRC.SC.PROTO out!, CHAN BOOL term.in?, term.out!, con.req?)

  BOOL FUNCTION isnumeric (VAL []BYTE s)
    BOOL r:
    VALOF
      IF
        IF i = 0 FOR SIZE s
          (s[i] < '0') OR (s[i] > '9')
            r := FALSE
        TRUE
          r := TRUE
      RESULT r
  :

  INT FUNCTION num.of.byte (VAL BYTE b)
    INT i:
    VALOF
      IF
        (b >= '0') AND (b <= '9')
          i := INT (b - '0')
        TRUE
          i := (-1)
      RESULT i
  :

  INT FUNCTION bytes.to.num (VAL []BYTE array)
    INT r:
    VALOF
      BOOL neg:
      INT sch:
      SEQ
        r := 0
        IF
          (SIZE array) = 0
            neg, sch := FALSE, 0
          array[0] = '-'
            neg, sch := TRUE, 1
          TRUE
            neg, sch := FALSE, 0
        WHILE (sch < (SIZE array))
          SEQ
            r := (r * 10)
            r := (r + num.of.byte (array[sch]))
            sch := (sch + 1)
        IF
          neg
            r := (-r)
          TRUE
            SKIP
      RESULT r
  :

  BOOL FUNCTION checkstart (VAL []BYTE haystack, needle)
    BOOL r:
    VALOF
      IF
        (SIZE haystack) < (SIZE needle)
          r := FALSE
        IF i = 0 FOR SIZE needle
          haystack[i] <> needle[i]
            r := FALSE
        TRUE
          r := TRUE
      RESULT r
  :

  INITIAL BOOL running IS TRUE:
  WHILE running
    PRI ALT
      BOOL any:
      term.in ? any
        SEQ
          term.out ! any
          running := FALSE
      BOOL any:
      con.req ? any
        out ! isconnected; TRUE
      [MAX.MESSAGE.SIZE]BYTE buffer:
      INT buflen:
      in ? buflen::buffer
        IF
          buflen = 0
            SKIP
          TRUE
            INT v.s, v.l:
            INT p:
            INITIAL BOOL unknown.data IS FALSE:
            SEQ
              --{{{  see if there's an originator prefix
              IF
                buffer[0] = ':'
                  SEQ
                    v.s := 1
                    v.l := 0
                    WHILE (buffer[v.s + v.l] <> ' ') AND ((v.s + v.l) < buflen)
                      v.l := v.l + 1
                    p := (v.s + v.l) + 1
                TRUE
                  SEQ
                    v.s, v.l := 0, 0
                    p := 0
              --}}}  
              --{{{  parse something
              IF
                checkstart ([buffer FROM p], "NOTICE ")
                  INT t.s, t.l:
                  INT m.s, m.l:
                  SEQ
                    t.s := p + 7
                    t.l := 0
                    WHILE (buffer[t.s + t.l] <> ' ') AND ((t.s + t.l) < buflen)
                      t.l := t.l + 1
                    m.s := (t.s + t.l) + 1
                    m.l := 0
                    IF
                      buffer[m.s] = ':'
                        m.s := m.s + 1
                      TRUE
                        SKIP
                    m.l := buflen - m.s
                    out ! notice; v.l::[buffer FROM v.s FOR v.l]; t.l::[buffer FROM t.s FOR t.l]; m.l::[buffer FROM m.s FOR m.l]
                checkstart ([buffer FROM p], "PRIVMSG ")
                  INT t.s, t.l:
                  INT m.s, m.l:
                  SEQ
                    t.s := p + 8
                    t.l := 0
                    WHILE (buffer[t.s + t.l] <> ' ') AND ((t.s + t.l) < buflen)
                      t.l := t.l + 1
                    m.s := (t.s + t.l) + 1
                    m.l := 0
                    IF
                      buffer[m.s] = ':'
                        m.s := m.s + 1
                      TRUE
                        SKIP
                    m.l := buflen - m.s
                    out ! privmsg; v.l::[buffer FROM v.s FOR v.l]; t.l::[buffer FROM t.s FOR t.l]; m.l::[buffer FROM m.s FOR m.l]
                checkstart ([buffer FROM p], "PING ")
                  INT s1.s, s1.l:
                  INT s2.s, s2.l:
                  SEQ
                    s1.s := p + 5
                    s1.l := 0
                    WHILE (buffer[s1.s + s1.l] <> ' ') AND ((s1.s + s1.l) < buflen)
                      s1.l := s1.l + 1
                    IF
                      (s1.s + s1.l) < buflen
                        SEQ
                          s2.s := (s1.s + s1.l) + 1
                          s2.l := 0
                          IF
                            buffer[s2.s] = ':'
                              s2.s := s2.s + 1
                            TRUE
                              SKIP
                          s2.l := buflen - s2.s
                      TRUE
                        s2.s, s2.l := 0, 0
                    out ! ping; s1.l::[buffer FROM s1.s FOR s1.l]; s2.l::[buffer FROM s2.s FOR s2.l]
                checkstart ([buffer FROM p], "JOIN ")
                  INT c.s, c.l:
                  SEQ
                    c.s := p + 5
                    c.l := buflen - c.s
                    out ! join; v.l::[buffer FROM v.s FOR v.l]; c.l::[buffer FROM c.s FOR c.l]
                checkstart ([buffer FROM p], "PART ")
                  INT c.s, c.l:
                  SEQ
                    c.s := p + 5
                    c.l := buflen - c.s
                    out ! part; v.l::[buffer FROM v.s FOR v.l]; c.l::[buffer FROM c.s FOR c.l]
                (p + 4) < buflen
                  IF
                    isnumeric ([buffer FROM p FOR 3]) AND (buffer[p+3] = ' ')
                      INT c.s, c.l, code:
                      INT m.s, m.l:
                      SEQ
                        c.s := p
                        c.l := 3
                        m.s := p+4
                        m.l := buflen - m.s
                        code := bytes.to.num ([buffer FROM c.s FOR c.l])
                        IF
                          code < 200
                            out ! unknown; v.l::[buffer FROM v.s FOR v.l]; code; m.l::[buffer FROM m.s FOR m.l]
                          code < 400
                            out ! repl; v.l::[buffer FROM v.s FOR v.l]; code; m.l::[buffer FROM m.s FOR m.l]
                          code < 600
                            out ! error; v.l::[buffer FROM v.s FOR v.l]; code; m.l::[buffer FROM m.s FOR m.l]
                          TRUE
                            out ! unknown; v.l::[buffer FROM v.s FOR v.l]; code; m.l::[buffer FROM m.s FOR m.l]
                    TRUE
                      SKIP
                TRUE
                  unknown.data := TRUE
              --}}}  
              --{{{  read anything we couldn't handle ?
              IF
                unknown.data
                  INT p.l:
                  SEQ
                    p.l := buflen - p
                    IF
                      p.l > 0
                        p, p.l := p + 1, p.l - 1
                      TRUE
                        SKIP
                    out ! unprocessed; v.l::[buffer FROM v.s FOR v.l]; p.l::[buffer FROM p FOR p.l]
                TRUE
                  SKIP
              --}}}  
:
--}}}  
--{{{  PROC ircplug.decode.in (SOCKET irc.socket, CHAN ICB out!, CHAN BOOL term!)
PROC ircplug.decode.in (SOCKET irc.socket, CHAN ICB out!, CHAN BOOL term!)
  INITIAL BOOL running IS TRUE:
  [MAX.MESSAGE.SIZE * 2]BYTE buffer:
  INITIAL INT len IS 0:
  INITIAL INT lastlen IS 0:
  INITIAL INT left IS SIZE buffer:
  WHILE running
    INT r:
    INITIAL BOOL got.data IS FALSE:
    SEQ
      socket.read (irc.socket, [buffer FROM len], left, r)
      IF
        r = 0
          --{{{  remote host closed socket
          SEQ
            term ! TRUE
            running := FALSE
          --}}}  
        r > 0
          --{{{  read something
          SEQ
            got.data := TRUE
            len := len + r
            left := left - r
          --}}}  
        TRUE
          --{{{  error
          SEQ
            out ! 0::""
            term ! TRUE
          --}}}  
      WHILE got.data
        SEQ
          INITIAL INT got.line IS -1:
          SEQ
            IF
              (len - lastlen) < 2
                SKIP
              IF i = lastlen FOR ((len - lastlen) - 1)
                (buffer[i] = #0D) AND (buffer[i+1] = #0A)
                  SEQ
                    got.line := i
                    lastlen := i + 2
              TRUE
                SKIP
            IF
              got.line >= 0
                SEQ
                  out ! got.line::buffer
                  len := len - lastlen
                  left := left + lastlen
                  SEQ i = 0 FOR len
                    buffer[i] := buffer[i + lastlen]
                  lastlen := 0
                  IF
                    len = 0
                      got.data := FALSE
                    TRUE
                      SKIP
              TRUE
                got.data := FALSE
:
--}}}  
--{{{  PROC ircplug.client (CHAN IRC.CS.PROTO in?, CHAN IRC.SC.PROTO out!)
PROC ircplug.client (CHAN IRC.CS.PROTO in?, CHAN IRC.SC.PROTO out!)
  SOCKET irc.socket:
  #PRAGMA SHARED irc.socket
  WHILE TRUE
    SEQ
      --{{{  only accept the connect/isconnected messages
      INITIAL BOOL connected IS FALSE:
      WHILE NOT connected
        in ? CASE
          isconnected
            out ! isconnected; connected
          [MAX.MESSAGE.SIZE]BYTE svr:
          INT port, svr.len:
          connect; svr.len::svr; port
            INT r, svr.addr:
            SEQ
              socket.addr.of.host ([svr FOR svr.len], svr.addr, r)
	      IF
	        r <> 0
		  SEQ
                    connected := FALSE
                    out ! connected; FALSE
		TRUE
		  SEQ
                    socket.create.connect.tcp (irc.socket, svr.addr, port, r)
		    IF
		      r <> 0
		        SEQ
                          connected := FALSE
                          out ! connected; FALSE
	              TRUE
		        SEQ
                          connected := TRUE
                          out ! connected; TRUE
      --}}}  
      --{{{  now connected to the server
      CHAN BOOL term1, term2, con.req:
      CHAN ICB lines:
      PAR
        ircplug.decode.out (irc.socket, in?, term2?, con.req!)
        ircplug.decode.in (irc.socket, lines!, term1!)
        ircplug.decode.in2 (lines?, out!, term1?, term2!, con.req?)
      --}}}  
      --{{{  tidy-up
      SEQ
        out ! connected; FALSE
        socket.close (irc.socket)
      --}}}  
:
--}}}  
