changeset 370:57d78a0af132

Add code to socket module to allow listening for incoming connections
author Michael Pavone <pavone@retrodev.com>
date Wed, 12 Aug 2015 19:13:31 -0700
parents 6b5096b07dd5
children 625b0aa9c204
files modules/socket.tp
diffstat 1 files changed, 105 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/modules/socket.tp	Wed Aug 12 19:13:04 2015 -0700
+++ b/modules/socket.tp	Wed Aug 12 19:13:31 2015 -0700
@@ -41,9 +41,8 @@
 		fd num!: (socket: (domain num) (type num) (protocol num))
 		fd
 	}
-
-	new <- :domain type protocol {
-		sfd <- socket: domain type protocol
+	
+	_sock_obj <- :sfd {
 		#{
 			fd <- {sfd}
 
@@ -113,6 +112,41 @@
 			}
 		}
 	}
+	
+	_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
@@ -145,12 +179,78 @@
 		freeaddrinfo: info
 		sock
 	}
+	
 
 	connectTo:onPort <- :host :port {
 		_connectTo: host onPort: (string: port)
 	}
-	listenOn <- :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
+		}
 	}
-	listenAt:onPort <- :host :port {
+	
+	listenOnPort <- :port {
+		listenAt: "" onPort: port
 	}
 }