| 1 | (* Copyright (C) 2012,2013,2015,2017 Matthew Fluet. |
| 2 | * Copyright (C) 2002-2008 Henry Cejtin, Matthew Fluet, Suresh |
| 3 | * Jagannathan, and Stephen Weeks. |
| 4 | * |
| 5 | * MLton is released under a BSD-style license. |
| 6 | * See the file MLton-LICENSE for details. |
| 7 | *) |
| 8 | |
| 9 | structure Socket :> SOCKET_EXTRA = |
| 10 | struct |
| 11 | |
| 12 | structure Prim = PrimitiveFFI.Socket |
| 13 | structure Error = Posix.Error |
| 14 | structure Syscall = Error.SysCall |
| 15 | structure FileSys = Posix.FileSys |
| 16 | |
| 17 | structure Sock = Net.Sock |
| 18 | type sock = Sock.t |
| 19 | val fromRep = Sock.fromRep |
| 20 | val toRep = Sock.toRep |
| 21 | val sockToWord = C_Sock.castToSysWord o Sock.toRep |
| 22 | val wordToSock = Sock.fromRep o C_Sock.castFromSysWord |
| 23 | val sockToFD = PrePosix.FileDesc.fromRep o Sock.toRep |
| 24 | val fdToSock = Sock.fromRep o PrePosix.FileDesc.toRep |
| 25 | |
| 26 | type pre_sock_addr = Word8.word array |
| 27 | datatype sock_addr = SA of Word8.word vector |
| 28 | fun unpackSockAddr (SA sa) = sa |
| 29 | fun newSockAddr (): (pre_sock_addr * C_Socklen.t ref * (unit -> sock_addr)) = |
| 30 | let |
| 31 | val salen = C_Size.toInt Prim.sockAddrStorageLen |
| 32 | val sa = Array.array (salen, 0wx0: Word8.word) |
| 33 | val salenRef = ref (C_Socklen.fromInt salen) |
| 34 | fun finish () = |
| 35 | SA (ArraySlice.vector |
| 36 | (ArraySlice.slice (sa, 0, SOME (C_Socklen.toInt (!salenRef))))) |
| 37 | in |
| 38 | (sa, salenRef, finish) |
| 39 | end |
| 40 | datatype dgram = DGRAM (* phantom *) |
| 41 | datatype stream = MODE (* phantom *) |
| 42 | datatype passive = PASSIVE (* phantom *) |
| 43 | datatype active = ACTIVE (* phantom *) |
| 44 | |
| 45 | structure AddrFamily = Net.AddrFamily |
| 46 | structure AF = |
| 47 | struct |
| 48 | type addr_family = AddrFamily.t |
| 49 | val names : (string * addr_family) list = |
| 50 | ("UNIX", AddrFamily.fromRep Prim.AF.UNIX) :: |
| 51 | ("INET", AddrFamily.fromRep Prim.AF.INET) :: |
| 52 | ("INET6", AddrFamily.fromRep Prim.AF.INET6) :: |
| 53 | ("UNSPEC", AddrFamily.fromRep Prim.AF.UNSPEC) :: |
| 54 | nil |
| 55 | fun list () = names |
| 56 | fun toString af' = |
| 57 | case List.find (fn (_, af) => af = af') names of |
| 58 | SOME (name, _) => name |
| 59 | | NONE => raise (Fail "Internal error: bogus addr_family") |
| 60 | fun fromString name' = |
| 61 | case List.find (fn (name, _) => name = name') names of |
| 62 | SOME (_, af) => SOME af |
| 63 | | NONE => NONE |
| 64 | end |
| 65 | |
| 66 | structure SockType = Net.SockType |
| 67 | structure SOCK = |
| 68 | struct |
| 69 | type sock_type = SockType.t |
| 70 | val toRep = SockType.toRep |
| 71 | val fromRep = SockType.fromRep |
| 72 | val stream = SockType.fromRep Prim.SOCK.STREAM |
| 73 | val dgram = SockType.fromRep Prim.SOCK.DGRAM |
| 74 | val names : (string * sock_type) list = |
| 75 | ("STREAM", stream) :: |
| 76 | ("DGRAM", dgram) :: |
| 77 | nil |
| 78 | fun list () = names |
| 79 | fun toString st' = |
| 80 | case List.find (fn (_, st) => st = st') names of |
| 81 | SOME (name, _) => name |
| 82 | | NONE => raise (Fail "Internal error: bogus sock_type") |
| 83 | fun fromString name' = |
| 84 | case List.find (fn (name, _) => name = name') names of |
| 85 | SOME (_, st) => SOME st |
| 86 | | NONE => NONE |
| 87 | end |
| 88 | structure SOCKExtra = SOCK |
| 89 | |
| 90 | structure CtlExtra = |
| 91 | struct |
| 92 | type level = C_Int.t |
| 93 | type optname = C_Int.t |
| 94 | type request = C_Int.t |
| 95 | |
| 96 | fun getSockOptC_Int (level: level, optname: optname) s : C_Int.t = |
| 97 | let |
| 98 | val optval = ref (C_Int.fromInt 0) |
| 99 | val () = |
| 100 | Syscall.simple |
| 101 | (fn () => Prim.Ctl.getSockOptC_Int (Sock.toRep s, level, optname, optval)) |
| 102 | in |
| 103 | ! optval |
| 104 | end |
| 105 | fun setSockOptC_Int (level: level, optname: optname) (s, optval: C_Int.t) : unit = |
| 106 | let |
| 107 | val () = |
| 108 | Syscall.simple |
| 109 | (fn () => Prim.Ctl.setSockOptC_Int (Sock.toRep s, level, optname, optval)) |
| 110 | in |
| 111 | () |
| 112 | end |
| 113 | |
| 114 | fun getSockOptBool (level: level, optname: optname) s : bool = |
| 115 | if getSockOptC_Int (level, optname) s = 0 then false else true |
| 116 | fun setSockOptBool (level: level, optname: optname) (s, optval: bool) : unit = |
| 117 | setSockOptC_Int (level, optname) (s, if optval then C_Int.fromInt 1 else C_Int.fromInt 0) |
| 118 | fun gsSockOptBool (level: level, optname: optname) = |
| 119 | (getSockOptBool (level, optname), setSockOptBool (level, optname)) |
| 120 | |
| 121 | fun getSockOptInt (level: level, optname: optname) s : int = |
| 122 | C_Int.toInt (getSockOptC_Int (level, optname) s) |
| 123 | fun setSockOptInt (level: level, optname: optname) (s, optval: int) : unit = |
| 124 | setSockOptC_Int (level, optname) (s, C_Int.fromInt optval) |
| 125 | fun gsSockOptInt (level: level, optname: optname) = |
| 126 | (getSockOptInt (level, optname), setSockOptInt (level, optname)) |
| 127 | |
| 128 | fun getSockOptTimeOption (level: level, optname: optname) s : Time.time option = |
| 129 | let |
| 130 | val optval_l_onoff = ref (C_Int.fromInt 0) |
| 131 | val optval_l_linger = ref (C_Int.fromInt 0) |
| 132 | val () = |
| 133 | Syscall.simple |
| 134 | (fn () => Prim.Ctl.getSockOptC_Linger (Sock.toRep s, level, optname, |
| 135 | optval_l_onoff, optval_l_linger)) |
| 136 | |
| 137 | in |
| 138 | if ! optval_l_onoff = 0 |
| 139 | then NONE |
| 140 | else SOME (Time.fromSeconds (C_Int.toLarge (! optval_l_linger))) |
| 141 | end |
| 142 | fun setSockOptTimeOption (level: level, optname: optname) (s, optval: Time.time option) : unit = |
| 143 | let |
| 144 | val (optval_l_onoff, optval_l_linger) = |
| 145 | case optval of |
| 146 | NONE => (C_Int.fromInt 0, C_Int.fromInt 0) |
| 147 | | SOME t => (C_Int.fromInt 1, C_Int.fromLarge (Time.toSeconds t)) |
| 148 | val () = |
| 149 | Syscall.simple |
| 150 | (fn () => Prim.Ctl.setSockOptC_Linger (Sock.toRep s, level, optname, |
| 151 | optval_l_onoff, optval_l_linger)) |
| 152 | |
| 153 | in |
| 154 | () |
| 155 | end |
| 156 | |
| 157 | val (getDEBUG, setDEBUG) = gsSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DEBUG) |
| 158 | val (getREUSEADDR, setREUSEADDR) = gsSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_REUSEADDR) |
| 159 | val (getKEEPALIVE, setKEEPALIVE) = gsSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_KEEPALIVE) |
| 160 | val (getDONTROUTE, setDONTROUTE) = gsSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_DONTROUTE) |
| 161 | val getLINGER = getSockOptTimeOption (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER) |
| 162 | val setLINGER = setSockOptTimeOption (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_LINGER) |
| 163 | val (getBROADCAST, setBROADCAST) = gsSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_BROADCAST) |
| 164 | val (getOOBINLINE, setOOBINLINE) = gsSockOptBool (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_OOBINLINE) |
| 165 | val (getSNDBUF, setSNDBUF) = gsSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_SNDBUF) |
| 166 | val (getRCVBUF, setRCVBUF) = gsSockOptInt (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_RCVBUF) |
| 167 | fun getTYPE s = SOCK.fromRep (getSockOptC_Int (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_TYPE) s) |
| 168 | fun getERROR s = |
| 169 | let |
| 170 | val se = getSockOptC_Int (Prim.Ctl.SOL_SOCKET, Prim.Ctl.SO_ERROR) s |
| 171 | val se = PrePosix.SysError.fromRep se |
| 172 | in |
| 173 | if PosixError.cleared = se |
| 174 | then NONE |
| 175 | else SOME (Error.errorMsg se, SOME se) |
| 176 | end handle Error.SysErr z => SOME z |
| 177 | |
| 178 | local |
| 179 | fun getName (s, f: C_Sock.t * pre_sock_addr * C_Socklen.t ref -> C_Int.int C_Errno.t) = |
| 180 | let |
| 181 | val (sa, salen, finish) = newSockAddr () |
| 182 | val () = Syscall.simple (fn () => f (Sock.toRep s, sa, salen)) |
| 183 | in |
| 184 | finish () |
| 185 | end |
| 186 | in |
| 187 | fun getPeerName s = getName (s, Prim.Ctl.getPeerName) |
| 188 | fun getSockName s = getName (s, Prim.Ctl.getSockName) |
| 189 | end |
| 190 | fun getNREAD s = |
| 191 | let |
| 192 | val argp = ref (C_Int.fromInt ~1) |
| 193 | val () = Syscall.simple (fn () => Prim.Ctl.getNREAD (Sock.toRep s, argp)) |
| 194 | in |
| 195 | C_Int.toInt (!argp) |
| 196 | end |
| 197 | fun getATMARK s = |
| 198 | let |
| 199 | val argp = ref (C_Int.fromInt ~1) |
| 200 | val () = Syscall.simple (fn () => Prim.Ctl.getATMARK (Sock.toRep s, argp)) |
| 201 | in |
| 202 | if C_Int.toInt (!argp) = 0 then false else true |
| 203 | end |
| 204 | end |
| 205 | |
| 206 | structure Ctl = |
| 207 | struct |
| 208 | open CtlExtra |
| 209 | |
| 210 | val getERROR = isSome o CtlExtra.getERROR |
| 211 | end |
| 212 | |
| 213 | fun sameAddr (SA sa1, SA sa2) = sa1 = sa2 |
| 214 | |
| 215 | fun familyOfAddr (SA sa) = AddrFamily.fromRep (Prim.familyOfAddr sa) |
| 216 | |
| 217 | fun bind (s, SA sa) = |
| 218 | Syscall.simple (fn () => Prim.bind (Sock.toRep s, sa, C_Socklen.fromInt (Vector.length sa))) |
| 219 | |
| 220 | fun listen (s, n) = |
| 221 | Syscall.simple (fn () => Prim.listen (Sock.toRep s, C_Int.fromInt n)) |
| 222 | |
| 223 | fun nonBlock' ({restart: bool}, |
| 224 | errVal : ''a, f : unit -> ''a C_Errno.t, post : ''a -> 'b, again, no : 'b) = |
| 225 | Syscall.syscallErr |
| 226 | ({clear = false, restart = restart, errVal = errVal}, fn () => |
| 227 | {return = f (), |
| 228 | post = post, |
| 229 | handlers = [(again, fn () => no)]}) |
| 230 | |
| 231 | fun nonBlock (errVal, f, post, no) = |
| 232 | nonBlock' ({restart = true}, errVal, f, post, Error.again, no) |
| 233 | |
| 234 | local |
| 235 | structure PIO = PrimitiveFFI.Posix.IO |
| 236 | structure OS = Primitive.MLton.Platform.OS |
| 237 | structure MinGW = PrimitiveFFI.MinGW |
| 238 | |
| 239 | fun withNonBlockNormal (s, f: unit -> 'a) = |
| 240 | let |
| 241 | val fd = Sock.toRep s |
| 242 | val flags = |
| 243 | Syscall.simpleResultRestart (fn () => PIO.fcntl2 (fd, PIO.F_GETFL)) |
| 244 | val () = |
| 245 | Syscall.simpleRestart |
| 246 | (fn () => |
| 247 | PIO.fcntl3 (fd, PIO.F_SETFL, |
| 248 | C_Int.orb (flags, PrimitiveFFI.Posix.FileSys.O.NONBLOCK))) |
| 249 | in |
| 250 | DynamicWind.wind |
| 251 | (f, fn () => |
| 252 | Syscall.simpleRestart (fn () => PIO.fcntl3 (fd, PIO.F_SETFL, flags))) |
| 253 | end |
| 254 | |
| 255 | fun withNonBlockMinGW (s, f: unit -> 'a) = |
| 256 | let |
| 257 | val fd = Sock.toRep s |
| 258 | val () = MinGW.setNonBlock fd |
| 259 | in |
| 260 | DynamicWind.wind |
| 261 | (f, fn () => MinGW.clearNonBlock fd) |
| 262 | end |
| 263 | in |
| 264 | val withNonBlock = fn x => |
| 265 | case OS.host of |
| 266 | OS.MinGW => withNonBlockMinGW x |
| 267 | | _ => withNonBlockNormal x |
| 268 | end |
| 269 | |
| 270 | fun connect (s, SA sa) = |
| 271 | Syscall.simple (fn () => Prim.connect (Sock.toRep s, sa, C_Socklen.fromInt (Vector.length sa))) |
| 272 | |
| 273 | fun connectNB (s, SA sa) = |
| 274 | nonBlock' |
| 275 | ({restart = false}, C_Int.fromInt ~1, fn () => |
| 276 | withNonBlock (s, fn () => Prim.connect (Sock.toRep s, sa, C_Socklen.fromInt (Vector.length sa))), |
| 277 | fn _ => true, |
| 278 | Error.inprogress, false) |
| 279 | |
| 280 | fun accept s = |
| 281 | let |
| 282 | val (sa, salen, finish) = newSockAddr () |
| 283 | val s = Syscall.simpleResultRestart (fn () => Prim.accept (Sock.toRep s, sa, salen)) |
| 284 | in |
| 285 | (Sock.fromRep s, finish ()) |
| 286 | end |
| 287 | |
| 288 | fun acceptNB s = |
| 289 | let |
| 290 | val (sa, salen, finish) = newSockAddr () |
| 291 | in |
| 292 | nonBlock |
| 293 | (C_Int.fromInt ~1, |
| 294 | fn () => withNonBlock (s, fn () => Prim.accept (Sock.toRep s, sa, salen)), |
| 295 | fn s => SOME (Sock.fromRep s, finish ()), |
| 296 | NONE) |
| 297 | end |
| 298 | |
| 299 | fun close s = Syscall.simple (fn () => Prim.close (Sock.toRep s)) |
| 300 | |
| 301 | datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS |
| 302 | |
| 303 | fun shutdownModeToHow m = |
| 304 | case m of |
| 305 | NO_RECVS => Prim.SHUT_RD |
| 306 | | NO_SENDS => Prim.SHUT_WR |
| 307 | | NO_RECVS_OR_SENDS => Prim.SHUT_RDWR |
| 308 | |
| 309 | fun shutdown (s, m) = |
| 310 | let val m = shutdownModeToHow m |
| 311 | in Syscall.simple (fn () => Prim.shutdown (Sock.toRep s, m)) |
| 312 | end |
| 313 | |
| 314 | type sock_desc = FileSys.file_desc |
| 315 | |
| 316 | fun sockDesc sock = sockToFD sock |
| 317 | |
| 318 | fun sameDesc (desc1, desc2) = desc1 = desc2 |
| 319 | |
| 320 | fun select {rds: sock_desc list, |
| 321 | wrs: sock_desc list, |
| 322 | exs: sock_desc list, |
| 323 | timeout: Time.time option} = |
| 324 | let |
| 325 | local |
| 326 | fun mk l = |
| 327 | let |
| 328 | val vec = Vector.fromList l |
| 329 | val arr = Array.array (Vector.length vec, 0: C_Int.t) |
| 330 | in |
| 331 | (PrePosix.FileDesc.vectorToRep vec, arr) |
| 332 | end |
| 333 | in |
| 334 | val (read_vec, read_arr) = mk rds |
| 335 | val (write_vec, write_arr) = mk wrs |
| 336 | val (except_vec, except_arr) = mk exs |
| 337 | end |
| 338 | val setTimeout = |
| 339 | case timeout of |
| 340 | NONE => Prim.setTimeoutNull |
| 341 | | SOME t => |
| 342 | if Time.< (t, Time.zeroTime) |
| 343 | then Error.raiseSys Error.inval |
| 344 | else let |
| 345 | val q = LargeInt.quot (Time.toMicroseconds t, 1000000) |
| 346 | val q = C_Time.fromLargeInt q |
| 347 | val r = LargeInt.rem (Time.toMicroseconds t, 1000000) |
| 348 | val r = C_SUSeconds.fromLargeInt r |
| 349 | in |
| 350 | fn () => Prim.setTimeout (q, r) |
| 351 | end handle Overflow => Error.raiseSys Error.inval |
| 352 | val res = |
| 353 | Syscall.simpleResult |
| 354 | (fn () => |
| 355 | (setTimeout () |
| 356 | ; Prim.select (read_vec, write_vec, except_vec, |
| 357 | read_arr, write_arr, except_arr))) |
| 358 | val (rds, wrs, exs) = |
| 359 | if res = 0 |
| 360 | then ([],[],[]) |
| 361 | else |
| 362 | let |
| 363 | fun mk (l, arr) = |
| 364 | (List.rev o #1) |
| 365 | (List.foldl (fn (sd, (l, i)) => |
| 366 | (if Array.sub (arr, i) <> (0: C_Int.t) then sd::l else l, i + 1)) |
| 367 | ([], 0) |
| 368 | l) |
| 369 | in |
| 370 | (mk (rds, read_arr), |
| 371 | mk (wrs, write_arr), |
| 372 | mk (exs, except_arr)) |
| 373 | end |
| 374 | in |
| 375 | {rds = rds, |
| 376 | wrs = wrs, |
| 377 | exs = exs} |
| 378 | end |
| 379 | |
| 380 | val ioDesc = FileSys.fdToIOD o sockDesc |
| 381 | |
| 382 | type out_flags = {don't_route: bool, oob: bool} |
| 383 | |
| 384 | val no_out_flags = {don't_route = false, oob = false} |
| 385 | |
| 386 | fun mk_out_flags {don't_route, oob} = |
| 387 | C_Int.orb (if don't_route then Prim.MSG_DONTROUTE else 0x0, |
| 388 | C_Int.orb (if oob then Prim.MSG_OOB else 0x0, |
| 389 | 0x0)) |
| 390 | |
| 391 | local |
| 392 | fun make (toPoly, base, primSend, primSendTo) = |
| 393 | let |
| 394 | val base = fn sl => let val (buf, i, sz) = base sl |
| 395 | in (toPoly buf, i, sz) |
| 396 | end |
| 397 | fun send' (s, sl, out_flags) = |
| 398 | let |
| 399 | val (buf, i, sz) = base sl |
| 400 | in |
| 401 | (C_SSize.toInt o Syscall.simpleResultRestart') |
| 402 | ({errVal = C_SSize.castFromFixedInt ~1}, fn () => |
| 403 | primSend (Sock.toRep s, buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 404 | mk_out_flags out_flags)) |
| 405 | end |
| 406 | fun send (sock, buf) = send' (sock, buf, no_out_flags) |
| 407 | fun sendNB' (s, sl, out_flags) = |
| 408 | let |
| 409 | val (buf, i, sz) = base sl |
| 410 | in |
| 411 | nonBlock |
| 412 | (C_SSize.castFromFixedInt ~1, |
| 413 | fn () => |
| 414 | primSend (Sock.toRep s, buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 415 | C_Int.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags)), |
| 416 | SOME o C_SSize.toInt, |
| 417 | NONE) |
| 418 | end |
| 419 | fun sendNB (sock, sl) = sendNB' (sock, sl, no_out_flags) |
| 420 | fun sendTo' (s, SA sa, sl, out_flags) = |
| 421 | let |
| 422 | val (buf, i, sz) = base sl |
| 423 | in |
| 424 | Syscall.simpleRestart' |
| 425 | ({errVal = C_SSize.castFromFixedInt ~1}, fn () => |
| 426 | primSendTo (Sock.toRep s, buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 427 | mk_out_flags out_flags, |
| 428 | sa, C_Socklen.fromInt (Vector.length sa))) |
| 429 | end |
| 430 | fun sendTo (sock, sock_addr, sl) = |
| 431 | sendTo' (sock, sock_addr, sl, no_out_flags) |
| 432 | fun sendToNB' (s, SA sa, sl, out_flags) = |
| 433 | let |
| 434 | val (buf, i, sz) = base sl |
| 435 | in |
| 436 | nonBlock |
| 437 | (C_SSize.castFromFixedInt ~1, |
| 438 | fn () => |
| 439 | primSendTo (Sock.toRep s, buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 440 | C_Int.orb (Prim.MSG_DONTWAIT, mk_out_flags out_flags), |
| 441 | sa, C_Socklen.fromInt (Vector.length sa)), |
| 442 | fn _ => true, |
| 443 | false) |
| 444 | end |
| 445 | fun sendToNB (sock, sa, sl) = |
| 446 | sendToNB' (sock, sa, sl, no_out_flags) |
| 447 | in |
| 448 | (send, send', sendNB, sendNB', sendTo, sendTo', sendToNB, sendToNB') |
| 449 | end |
| 450 | in |
| 451 | val (sendArr, sendArr', sendArrNB, sendArrNB', |
| 452 | sendArrTo, sendArrTo', sendArrToNB, sendArrToNB') = |
| 453 | make (Word8Array.toPoly, Word8ArraySlice.base, Prim.sendArr, Prim.sendArrTo) |
| 454 | val (sendVec, sendVec', sendVecNB, sendVecNB', |
| 455 | sendVecTo, sendVecTo', sendVecToNB, sendVecToNB') = |
| 456 | make (Word8Vector.toPoly, Word8VectorSlice.base, Prim.sendVec, Prim.sendVecTo) |
| 457 | end |
| 458 | |
| 459 | type in_flags = {peek: bool, oob: bool} |
| 460 | |
| 461 | val no_in_flags = {peek = false, oob = false} |
| 462 | |
| 463 | fun mk_in_flags {peek, oob} = |
| 464 | C_Int.orb (if peek then Prim.MSG_PEEK else 0x0, |
| 465 | C_Int.orb (if oob then Prim.MSG_OOB else 0x0, |
| 466 | 0x0)) |
| 467 | |
| 468 | fun recvArr' (s, sl, in_flags) = |
| 469 | let |
| 470 | val (buf, i, sz) = Word8ArraySlice.base sl |
| 471 | in |
| 472 | (C_SSize.toInt o Syscall.simpleResultRestart') |
| 473 | ({errVal = C_SSize.castFromFixedInt ~1}, fn () => |
| 474 | Prim.recv (Sock.toRep s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 475 | mk_in_flags in_flags)) |
| 476 | end |
| 477 | |
| 478 | fun getVec (a, n, bytesRead) = |
| 479 | if n = bytesRead |
| 480 | then Word8Vector.unsafeFromArray a |
| 481 | else Word8ArraySlice.vector (Word8ArraySlice.slice (a, 0, SOME bytesRead)) |
| 482 | |
| 483 | fun recvVec' (sock, n, in_flags) = |
| 484 | let |
| 485 | val a = Word8Array.alloc n |
| 486 | val bytesRead = |
| 487 | recvArr' (sock, Word8ArraySlice.full a, in_flags) |
| 488 | in |
| 489 | getVec (a, n, bytesRead) |
| 490 | end |
| 491 | |
| 492 | fun recvArr (sock, sl) = recvArr' (sock, sl, no_in_flags) |
| 493 | |
| 494 | fun recvVec (sock, n) = recvVec' (sock, n, no_in_flags) |
| 495 | |
| 496 | fun recvArrFrom' (s, sl, in_flags) = |
| 497 | let |
| 498 | val (buf, i, sz) = Word8ArraySlice.base sl |
| 499 | val (sa, salen, finish) = newSockAddr () |
| 500 | val n = |
| 501 | (C_SSize.toInt o Syscall.simpleResultRestart') |
| 502 | ({errVal = C_SSize.castFromFixedInt ~1}, fn () => |
| 503 | Prim.recvFrom (Sock.toRep s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 504 | mk_in_flags in_flags, |
| 505 | sa, salen)) |
| 506 | in |
| 507 | (n, finish ()) |
| 508 | end |
| 509 | |
| 510 | fun recvVecFrom' (sock, n, in_flags) = |
| 511 | let |
| 512 | val a = Word8Array.alloc n |
| 513 | val (bytesRead, sock_addr) = |
| 514 | recvArrFrom' (sock, Word8ArraySlice.full a, in_flags) |
| 515 | in |
| 516 | (getVec (a, n, bytesRead), sock_addr) |
| 517 | end |
| 518 | |
| 519 | fun recvArrFrom (sock, sl) = recvArrFrom' (sock, sl, no_in_flags) |
| 520 | |
| 521 | fun recvVecFrom (sock, n) = recvVecFrom' (sock, n, no_in_flags) |
| 522 | |
| 523 | fun mk_in_flagsNB in_flags = C_Int.orb (mk_in_flags in_flags, Prim.MSG_DONTWAIT) |
| 524 | |
| 525 | fun recvArrNB' (s, sl, in_flags) = |
| 526 | let |
| 527 | val (buf, i, sz) = Word8ArraySlice.base sl |
| 528 | in |
| 529 | nonBlock |
| 530 | (C_SSize.castFromFixedInt ~1, |
| 531 | fn () => Prim.recv (Sock.toRep s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 532 | mk_in_flagsNB in_flags), |
| 533 | SOME o C_SSize.toInt, |
| 534 | NONE) |
| 535 | end |
| 536 | |
| 537 | fun recvVecNB' (s, n, in_flags) = |
| 538 | let |
| 539 | val a = Word8Array.alloc n |
| 540 | in |
| 541 | nonBlock |
| 542 | (C_SSize.castFromFixedInt ~1, |
| 543 | fn () => Prim.recv (Sock.toRep s, Word8Array.toPoly a, 0, C_Size.fromInt n, |
| 544 | mk_in_flagsNB in_flags), |
| 545 | fn bytesRead => SOME (getVec (a, n, C_SSize.toInt bytesRead)), |
| 546 | NONE) |
| 547 | end |
| 548 | |
| 549 | fun recvArrNB (sock, sl) = recvArrNB' (sock, sl, no_in_flags) |
| 550 | |
| 551 | fun recvVecNB (sock, n) = recvVecNB' (sock, n, no_in_flags) |
| 552 | |
| 553 | fun recvArrFromNB' (s, sl, in_flags) = |
| 554 | let |
| 555 | val (buf, i, sz) = Word8ArraySlice.base sl |
| 556 | val (sa, salen, finish) = newSockAddr () |
| 557 | in |
| 558 | nonBlock |
| 559 | (C_SSize.castFromFixedInt ~1, |
| 560 | fn () => Prim.recvFrom (Sock.toRep s, Word8Array.toPoly buf, C_Int.fromInt i, C_Size.fromInt sz, |
| 561 | mk_in_flagsNB in_flags, sa, salen), |
| 562 | fn n => SOME (C_SSize.toInt n, finish ()), |
| 563 | NONE) |
| 564 | end |
| 565 | |
| 566 | fun recvVecFromNB' (s, n, in_flags) = |
| 567 | let |
| 568 | val a = Word8Array.alloc n |
| 569 | val (sa, salen, finish) = newSockAddr () |
| 570 | in |
| 571 | nonBlock |
| 572 | (C_SSize.castFromFixedInt ~1, |
| 573 | fn () => Prim.recvFrom (Sock.toRep s, Word8Array.toPoly a, 0, C_Size.fromInt n, |
| 574 | mk_in_flagsNB in_flags, sa, salen), |
| 575 | fn bytesRead => SOME (getVec (a, n, C_SSize.toInt bytesRead), finish ()), |
| 576 | NONE) |
| 577 | end |
| 578 | |
| 579 | fun recvArrFromNB (sock, sl) = recvArrFromNB' (sock, sl, no_in_flags) |
| 580 | |
| 581 | fun recvVecFromNB (sock, n) = recvVecFromNB' (sock, n, no_in_flags) |
| 582 | |
| 583 | (* Phantom type. *) |
| 584 | type ('af, 'sock_type) sock = sock |
| 585 | |
| 586 | type 'af sock_addr = sock_addr |
| 587 | |
| 588 | type 'mode stream = stream |
| 589 | |
| 590 | end |