utils-socket.stanza

;; See license.txt for details about licensing.

defpackage utils/socket :
  import core
  import collections
  import utils/buffered-stream

public lostanza deftype Socket <: PollableInputStream & OutputStream :
  var fd: int

extern close: (int) -> int
extern read: (int, ptr<byte>, int) -> int
extern write: (int, ptr<byte>, int) -> int
extern malloc: (int) -> ptr<byte>
extern free: (ptr<byte>) -> int
protected extern strerror: (int) -> ptr<byte>
protected extern get_errno: () -> int
extern socket_poll: (int) -> int
extern is_socket_closed: (int) -> int
extern server_socket_poll: (int, int, int) -> int
extern server_socket_open: (int) -> int
extern printf: (ptr<byte>, ? ...) -> int

public lostanza defn Socket (fd:ref<Int>) -> ref<Socket> :
  return new Socket{fd.value}

public lostanza defn poll (s:ref<Socket>) -> ref<True|False> :
  val res = call-c socket_poll(s.fd)
  if res == 0: return false else: return true

public lostanza defn closed? (s:ref<Socket>) -> ref<True|False> :
  val res = call-c is_socket_closed(s.fd)
  if res == 0: return false else: return true

public lostanza defn recv-into (s:ref<Socket>, buf:ref<CharArray>, i:ref<Int>) -> ref<Int> :
  val n = call-c read(s.fd, addr!(buf.chars) + i.value, buf.length as int)
  return new Int{n}

defmethod avail? (s:Socket) -> True|False :
  poll(s)

defmethod get-char (s:Socket) -> Char|False :
  val buf = CharArray(1)
  val n = recv-into(s, buf, 0)
  if n <= 0: false else: buf[0]

defmethod fill (xs:CharArray, r:Range, s:Socket) :
  ;; #if-not-defined(OPTIMIZE) :
  ;;    ensure-index-range(xs, r)
  val [b,e] = core/range-bound(xs, r)
  recv-into(s, xs, b)

public lostanza defn send (s:ref<Socket>, m:ref<String>) -> ref<False> :
  call-c write(s.fd, addr!(m.chars), length(m).value)
  return false

defmethod print (s:Socket, x:String) -> False :
  send(s, x)
  
defmethod print (s:Socket, x:Char) -> False :
  send(s, to-string(x))
  
public lostanza defn close (s:ref<Socket>) -> ref<False> :
  call-c close(s.fd)
  return false

public lostanza defn socket-fd (s:ref<Socket>) -> ref<Int> :
  return new Int{s.fd}

public deftype BufferedSocket <: MyBufferedInputStream & OutputStream
public defmulti socket (s:BufferedSocket) -> Socket 

public defn BufferedSocket (fd:Int) :
  val sock = Socket(fd)
  val buf  = CharBuffer(256, sock)
  new BufferedSocket :
    defmethod buffer (this) : buf
    defmethod print (this, s:String) : send(sock, s)
    defmethod print (this, c:Char) : print(this, to-string(c))
    defmethod socket (this) : sock

defmethod put (s:BufferedSocket, x:Byte) :
  print(s, to-char(x))

defmethod get-byte (s:BufferedSocket) -> False|Byte :
  match(get-char(s)) :
    (f:False) : false
    (c:Char) : to-byte(c)

public defn close (s:BufferedSocket) : close(socket(s))

public defn get-line (s:BufferedSocket) -> String :
  get-chars-while(s, { _ != '\n' })

extern socket_client: (ptr<byte>, int) -> int
extern socket_client_from_filename: (ptr<byte>) -> int

;; extern socket_server: (int, ptr<((int) -> int)>, ptr<((int, ptr<byte>) -> int)>, ptr<((int) -> int)>) -> int
;; 
;; defn default-open-callback (s:Socket) -> False: false
;; 
;; var *open-callback*:((Socket) -> False) = default-open-callback
;; 
;; extern defn do_open_callback (fd:int) -> int :
;;   val s = new Socket{fd}
;;   [*open-callback*](s)
;;   return 0
;; 
;; lostanza defn set-open-callback (f:ref<((Socket) -> False)>) -> ref<False> :
;;   *open-callback* = f
;;   return false
;; 
;; defn default-read-callback (s:Socket, buf:String) -> False: false
;; 
;; var *read-callback*:((Socket, String) -> False) = default-read-callback
;; 
;; extern defn do_read_callback (fd:int, buf:ptr<byte>) -> int :
;;   val s = new Socket{fd}
;;   val b = String(buf)
;;   [*read-callback*](s, b)
;;   return 0
;; 
;; lostanza defn set-read-callback (f:ref<((Socket, String) -> False)>) -> ref<False> :
;;   *read-callback* = f
;;   return false
;; 
;; defn default-close-callback (s:Socket) -> False: false
;; 
;; var *close-callback*:((Socket) -> False) = default-close-callback
;; 
;; extern defn do_close_callback (fd:int) -> int :
;;   val s = new Socket{fd}
;;   [*close-callback*](s)
;;   return 0
;; 
;; lostanza defn set-close-callback (f:ref<((Socket) -> False)>) -> ref<False> :
;;   *close-callback* = f
;;   return false

public defstruct SocketOpenException <: IOException :
   hostname: String
   portno: Int
   cause: String

defmethod print (o:OutputStream, e:SocketOpenException) :
   print(o, "Error occurred when attempting to open socket %_ %_. %_." % [hostname(e), portno(e), cause(e)])

public defstruct SocketOpenFilenameException <: IOException :
   filename: String
   cause: String

defmethod print (o:OutputStream, e:SocketOpenFilenameException) :
   print(o, "Error occurred when attempting to open socket %_ %_." % [filename(e), cause(e)])

lostanza defn linux-error-msg () -> ref<String> :
   val s = call-c strerror(call-c get_errno())
   return String(s)

public lostanza defn ClientFileDescriptor (hostname:ref<String>, port:ref<Int>) -> ref<Int> :
  val fd = call-c socket_client(addr!(hostname.chars), port.value)
  if fd < 0 : throw(SocketOpenException(hostname, port, linux-error-msg()))
  return new Int{fd}

public lostanza defn Client (filename:ref<String>) -> ref<BufferedSocket> :
  return BufferedSocket(ClientFileDescriptor(filename))

public lostanza defn ClientFileDescriptor (filename:ref<String>) -> ref<Int> :
  val fd = call-c socket_client_from_filename(addr!(filename.chars))
  if fd < 0 : throw(SocketOpenFilenameException(filename, linux-error-msg()))
  return new Int{fd}

public lostanza defn Client (hostname:ref<String>, port:ref<Int>) -> ref<BufferedSocket> :
  return BufferedSocket(ClientFileDescriptor(hostname, port))

extern repl_client_fd:int

public lostanza defn ReplClient (hostname:ref<String>, port:ref<Int>) -> ref<BufferedSocket> :
  if repl_client_fd == 0 :
    repl_client_fd = ClientFileDescriptor(hostname, port).value
  return BufferedSocket(new Int{repl_client_fd})

public lostanza defn ReplClient (filename:ref<String>) -> ref<BufferedSocket> :
  ; if repl_client_fd == 0 :
  ;   repl_client_fd = ClientFileDescriptor(filename).value
  ; return BufferedSocket(new Int{repl_client_fd})
  val fd = ClientFileDescriptor(filename).value
  return BufferedSocket(new Int{fd})

public deftype NullClient <: MyBufferedInputStream & OutputStream
public defn NullClient () :
  new NullClient :
    defmethod avail? (this) : false
    defmethod peek? (this) : false
    defmethod get-char (this) : false
    defmethod print (this, c:Char) : false

;; public lostanza defn Server
;;     (port:ref<Int>,
;;      open-callback:ref<((Socket) -> False)>,
;;      read-callback:ref<((Socket, String) -> False)>,
;;      close-callback:ref<((Socket) -> False)>) -> ref<False> :
;;   set-open-callback(open-callback)
;;   set-read-callback(read-callback)
;;   set-close-callback(close-callback)
;;   val fd = call-c socket_server(port.value, addr(do_open_callback), addr(do_read_callback), addr(do_close_callback))
;;   if fd < 0 : throw(SocketOpenException(String("localhost"), port, linux-error-msg()))
;;   return false

public lostanza deftype Server :
  var fd : int

public defstruct ServerSocketOpenException <: IOException :
   portno: Int
   cause: String

defmethod print (o:OutputStream, e:ServerSocketOpenException) :
   print(o, "Error occurred when attempting to open server socket %_. %_." % [portno(e), cause(e)])

public lostanza defn Server (port:ref<Int>) -> ref<Server> :
  val fd = call-c server_socket_open(port.value)
  if fd < 0 : throw(ServerSocketOpenException(port, linux-error-msg()))
  return new Server{fd}

public lostanza defn poll (server:ref<Server>, secs:ref<Int>, usecs:ref<Int>) -> ref<False|BufferedSocket> :
  val fd = call-c server_socket_poll(server.fd, secs.value, usecs.value)
  if fd > 0 :
    return BufferedSocket(new Int{fd})
  else :
    return false

public lostanza defn close (server:ref<Server>) -> ref<Int> :
  val res = call-c close(server.fd)
  return new Int{res}