Mercurial > repos > tabletprog
view modules/socket.tp @ 375:f8d80c16abbd
Add epoll module and a basic epoll sample
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Fri, 14 Aug 2015 23:08:54 -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 } }