view modules/socket.tp @ 347:ff7ea11b4b60

Add length method to executable bytearrays
author Michael Pavone <pavone@retrodev.com>
date Fri, 10 Apr 2015 00:48:12 -0700
parents 4c96a393103e
children 57d78a0af132
line wrap: on
line source
#{
	includeSystemHeader: "sys/types.h"
	includeSystemHeader: "sys/socket.h"
	includeSystemHeader: "netdb.h"

	llMessage: AF_INET withVars: {
		intret <- obj_int32 ptr
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: AF_INET
		intret
	}
	llMessage: AF_UNIX withVars: {
		intret <- obj_int32 ptr
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: AF_UNIX
		intret
	}
	llMessage: STREAM withVars: {
		intret <- obj_int32 ptr
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: SOCK_STREAM
		intret
	}
	llMessage: DGRAM withVars: {
		intret <- obj_int32 ptr
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: SOCK_DGRAM
		intret
	}
	llMessage: socket withVars: {
		fd <- obj_int32 ptr
		domain <- obj_int32 ptr
		type <- obj_int32 ptr
		protocol <- obj_int32 ptr
	} andCode: :domain type protocol {
		fd <- make_object: (addr_of: obj_int32_meta) NULL 0
		fd num!: (socket: (domain num) (type num) (protocol num))
		fd
	}

	new <- :domain type protocol {
		sfd <- socket: domain type protocol
		#{
			fd <- {sfd}

			llMessage: close withVars: {
				sfd <- obj_int32 ptr
			} andCode: {
				sfd <- mcall: fd 1 self
				close: (sfd num)
				self
			}

			llMessage: send:withFlags withVars: {
				odata <- object ptr
				flags <- obj_int32 ptr
				sdata <- string ptr
				sfd <- obj_int32 ptr
				res <- obj_int32 ptr
			} andCode: :odata :flags {
				sdata <- mcall: string 1 odata
				sfd <- mcall: fd 1 self
				res <- make_object: (addr_of: obj_int32_meta) NULL 0
				res num!: (send: (sfd num) (sdata data) (sdata bytes) (flags num))
				res
			}
			send <- :data {
				send: data withFlags: 0
			}

			llMessage: recv:withFlags withVars: {
				length <- obj_int32 ptr
				flags <- obj_int32 ptr
				sfd <- obj_int32 ptr
				res <- int
				buf <- char ptr
				out <- string ptr
			} andCode: :length :flags {
				sfd <- mcall: fd 1 self
				buf <- GC_MALLOC_ATOMIC: (length num) + 1
				res <- recv: (sfd num) buf (length num) (flags num)
				if: res < 0 {
					length <- make_object: (addr_of: obj_int32_meta) NULL 0
					length num!: res
					length
				} else: {
					out <- make_object: (addr_of: string_meta) NULL 0
					out bytes!: res
					out len!: res
					out data!: buf
					out
				}
			}
			recv <- :length {
				recv: length withFlags: 0
			}
			recvAll <- :len {
				received <- ""
				error <- false
				while: { (not: error) && (received length) < len} do: {
					res <- recv: (len - (received length))
					if: (res isInteger?) || (res length) = 0 {
						error <- true
					} else: {
						received <- received . res
					}
				}
				received
			}
		}
	}

	llMessage: _connectTo:onPort withVars: {
		host <- string ptr
		port <- string ptr
		hints <- struct: addrinfo
		info <- (struct: addrinfo) ptr
		domain <- obj_int32 ptr
		type <- obj_int32 ptr
		protocol <- obj_int32 ptr
		sock <- object ptr
		sfd <- obj_int32 ptr
	} andCode: :host :port {
		memset: (addr_of: hints) 0 (sizeof: hints)
		hints ai_family!: AF_UNSPEC
		hints ai_socktype!: SOCK_STREAM
		getaddrinfo: (host data) (port data) (addr_of: hints) (addr_of: info)

		domain <- make_object: (addr_of: obj_int32_meta) NULL 0
		domain num!: (info ai_family)
		type <- make_object: (addr_of: obj_int32_meta) NULL 0
		type num!: (info ai_socktype)
		protocol <- make_object: (addr_of: obj_int32_meta) NULL 0
		protocol num!: (info ai_protocol)

		sock <- mcall: new 4 self domain type protocol
		sfd <- mcall: fd 1 sock

		connect: (sfd num) (info ai_addr) (info ai_addrlen)

		freeaddrinfo: info
		sock
	}

	connectTo:onPort <- :host :port {
		_connectTo: host onPort: (string: port)
	}
	listenOn <- :port {
	}
	listenAt:onPort <- :host :port {
	}
}