view modules/socket.tp @ 377:93c28eee141e default tip

Merge
author Michael Pavone <pavone@retrodev.com>
date Sat, 15 Aug 2015 22:45:33 -0700
parents 57d78a0af132
children
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
	}
	
	_sock_obj <- :sfd {
		#{
			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
			}
		}
	}
	
	_accept_sock <- :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: accept withVars: {
				sfd <- obj_int32 ptr
				newfd <- obj_int32 ptr
			} andCode: {
				sfd <- mcall: fd 1 self
				newfd <- make_object: (addr_of: obj_int32_meta) NULL 0
				//TODO: expose peer address
				newfd num!: (accept: (sfd num) NULL NULL)
				if: (newfd num) >= 0 {
					mcall: value 2 option (mcall: _sock_obj 2 socket newfd)
				} else: {
					mcall: none 1 option
				}
			}
		}
	}

	new <- :domain type protocol {
		sfd <- socket: domain type protocol
		_sock_obj: sfd
	}

	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)
	}
	llMessage: listenAt:onPort withVars: {
		ohost <- object ptr
		host <- string ptr
		oport <- object ptr
		port <- string ptr
		hints <- struct: addrinfo
		info <- (struct: addrinfo) ptr
		curinfo <- (struct: addrinfo) ptr
		domain <- obj_int32 ptr
		type <- obj_int32 ptr
		protocol <- obj_int32 ptr
		sock <- object ptr
		sfd <- obj_int32 ptr
		result <- int32_t
		hstr <- uint8_t ptr
	} andCode: :ohost :oport {
		host <- (mcall: string 1 ohost) castTo: (string ptr)
		port <- (mcall: string 1 oport) castTo: (string ptr)
		memset: (addr_of: hints) 0 (sizeof: hints)
		hints ai_family!: AF_UNSPEC
		hints ai_socktype!: SOCK_STREAM
		hints ai_flags!: AI_PASSIVE
		hints ai_protocol!: 0
		hints ai_canonname!: NULL
		hints ai_addr!: NULL
		hints ai_next!: NULL
		result <- getaddrinfo
		if: (host bytes) = 0 {
			hstr <- NULL
		} else: {
			hstr <- host data
		}
		result <- getaddrinfo: hstr (port data) (addr_of: hints) (addr_of: info)
		if: result = 0 {
			curinfo <- info
			domain <- make_object: (addr_of: obj_int32_meta) NULL 0
			type <- make_object: (addr_of: obj_int32_meta) NULL 0
			protocol <- make_object: (addr_of: obj_int32_meta) NULL 0
			while: { curinfo != NULL } do: {
				domain num!: (curinfo ai_family)
				type num!: (curinfo ai_socktype)
				protocol num!: (curinfo ai_protocol)
				sock <- mcall: _accept_sock 4 self domain type protocol
				sfd <- (mcall: fd 1 sock) castTo: (obj_int32 ptr)
				if: (sfd num) != -1 {
					result <- bind: (sfd num) (curinfo ai_addr) (curinfo ai_addrlen)
					if: result = 0 {
						curinfo <- NULL
					} else: {
						//failed to bind, close this socket so we can try again
						close: (sfd num)
						sock <- NULL
					}
				}
			}
			if: sock {
				listen: (sfd num) 8
				mcall: value 2 option sock
			} else: {
				mcall: none 1 option
			}
		} else: {
			mcall: none 1 option
		}
	}
	
	listenOnPort <- :port {
		listenAt: "" onPort: port
	}
}