1(* 2 Title: Standard Basis Library: Generic Sockets 3 Author: David Matthews 4 Copyright David Matthews 2000, 2005, 2015-16 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20signature SOCKET = 21sig 22 type ('af,'sock_type) sock 23 type 'af sock_addr 24 type dgram 25 type 'mode stream 26 type passive 27 type active 28 29 structure AF : 30 sig 31 type addr_family = NetHostDB.addr_family 32 val list : unit -> (string * addr_family) list 33 val toString : addr_family -> string 34 val fromString : string -> addr_family option 35 end 36 37 structure SOCK : 38 sig 39 eqtype sock_type 40 val stream : sock_type 41 val dgram : sock_type 42 val list : unit -> (string * sock_type) list 43 val toString : sock_type -> string 44 val fromString : string -> sock_type option 45 end 46 47 structure Ctl : 48 sig 49 val getDEBUG : ('af, 'sock_type) sock -> bool 50 val setDEBUG : ('af, 'sock_type) sock * bool -> unit 51 val getREUSEADDR : ('af, 'sock_type) sock -> bool 52 val setREUSEADDR : ('af, 'sock_type) sock * bool -> unit 53 val getKEEPALIVE : ('af, 'sock_type) sock -> bool 54 val setKEEPALIVE : ('af, 'sock_type) sock * bool -> unit 55 val getDONTROUTE : ('af, 'sock_type) sock -> bool 56 val setDONTROUTE : ('af, 'sock_type) sock * bool -> unit 57 val getLINGER : ('af, 'sock_type) sock -> Time.time option 58 val setLINGER : ('af, 'sock_type) sock * Time.time option -> unit 59 val getBROADCAST : ('af, 'sock_type) sock -> bool 60 val setBROADCAST : ('af, 'sock_type) sock * bool -> unit 61 val getOOBINLINE : ('af, 'sock_type) sock -> bool 62 val setOOBINLINE : ('af, 'sock_type) sock * bool -> unit 63 val getSNDBUF : ('af, 'sock_type) sock -> int 64 val setSNDBUF : ('af, 'sock_type) sock * int -> unit 65 val getRCVBUF : ('af, 'sock_type) sock -> int 66 val setRCVBUF : ('af, 'sock_type) sock * int -> unit 67 val getTYPE : ('af, 'sock_type) sock -> SOCK.sock_type 68 val getERROR : ('af, 'sock_type) sock -> bool 69 val getPeerName : ('af, 'sock_type) sock -> 'af sock_addr 70 val getSockName : ('af, 'sock_type) sock -> 'af sock_addr 71 val getNREAD : ('af, 'sock_type) sock -> int 72 val getATMARK : ('af, active stream) sock -> bool 73 end 74 75 val sameAddr : 'af sock_addr * 'af sock_addr -> bool 76 val familyOfAddr : 'af sock_addr -> AF.addr_family 77 78 val bind : ('af, 'sock_type) sock * 'af sock_addr -> unit 79 val listen : ('af, passive stream) sock * int -> unit 80 val accept : ('af, passive stream) sock 81 -> ('af, active stream) sock * 'af sock_addr 82 val acceptNB : ('af, passive stream) sock 83 -> (('af, active stream) sock * 'af sock_addr) option 84 val connect : ('af, 'sock_type) sock * 'af sock_addr -> unit 85 val connectNB : ('af, 'sock_type) sock * 'af sock_addr -> bool 86 val close : ('af, 'sock_type) sock -> unit 87 88 datatype shutdown_mode 89 = NO_RECVS 90 | NO_SENDS 91 | NO_RECVS_OR_SENDS 92 93 val shutdown : ('af, 'sock_type stream) sock * shutdown_mode -> unit 94 95 type sock_desc 96 val sockDesc : ('af, 'sock_type) sock -> sock_desc 97 val sameDesc: sock_desc * sock_desc -> bool 98 99 100 val select: 101 { rds: sock_desc list, wrs : sock_desc list, exs : sock_desc list, timeout: Time.time option } -> 102 { rds: sock_desc list, wrs : sock_desc list, exs : sock_desc list } 103 104 val ioDesc : ('af, 'sock_type) sock -> OS.IO.iodesc 105 106 type out_flags = {don't_route : bool, oob : bool} 107 type in_flags = {peek : bool, oob : bool} 108 109 val sendVec : ('af, active stream) sock * Word8VectorSlice.slice -> int 110 val sendArr : ('af, active stream) sock * Word8ArraySlice.slice -> int 111 val sendVec' : ('af, active stream) sock * Word8VectorSlice.slice 112 * out_flags -> int 113 val sendArr' : ('af, active stream) sock * Word8ArraySlice.slice 114 * out_flags -> int 115 val sendVecNB : ('af, active stream) sock * Word8VectorSlice.slice -> int option 116 val sendArrNB : ('af, active stream) sock * Word8ArraySlice.slice -> int option 117 val sendVecNB' : ('af, active stream) sock * Word8VectorSlice.slice 118 * out_flags -> int option 119 val sendArrNB' : ('af, active stream) sock * Word8ArraySlice.slice 120 * out_flags -> int option 121 122 val recvVec : ('af, active stream) sock * int -> Word8Vector.vector 123 val recvArr : ('af, active stream) sock * Word8ArraySlice.slice -> int 124 val recvVec' : ('af, active stream) sock * int * in_flags 125 -> Word8Vector.vector 126 val recvArr' : ('af, active stream) sock * Word8ArraySlice.slice 127 * in_flags -> int 128 val recvVecNB : ('af, active stream) sock * int -> Word8Vector.vector option 129 val recvArrNB : ('af, active stream) sock * Word8ArraySlice.slice -> int option 130 val recvVecNB' : ('af, active stream) sock * int * in_flags 131 -> Word8Vector.vector option 132 val recvArrNB' : ('af, active stream) sock * Word8ArraySlice.slice 133 * in_flags -> int option 134 135 val sendVecTo : ('af, dgram) sock * 'af sock_addr 136 * Word8VectorSlice.slice -> unit 137 val sendArrTo : ('af, dgram) sock * 'af sock_addr 138 * Word8ArraySlice.slice -> unit 139 val sendVecTo' : ('af, dgram) sock * 'af sock_addr 140 * Word8VectorSlice.slice * out_flags -> unit 141 val sendArrTo' : ('af, dgram) sock * 'af sock_addr 142 * Word8ArraySlice.slice * out_flags -> unit 143 val sendVecToNB : ('af, dgram) sock * 'af sock_addr 144 * Word8VectorSlice.slice -> bool 145 val sendArrToNB : ('af, dgram) sock * 'af sock_addr 146 * Word8ArraySlice.slice -> bool 147 val sendVecToNB' : ('af, dgram) sock * 'af sock_addr 148 * Word8VectorSlice.slice * out_flags -> bool 149 val sendArrToNB' : ('af, dgram) sock * 'af sock_addr 150 * Word8ArraySlice.slice * out_flags -> bool 151 152 val recvVecFrom : ('af, dgram) sock * int 153 -> Word8Vector.vector * 'sock_type sock_addr 154 val recvArrFrom : ('af, dgram) sock * Word8ArraySlice.slice 155 -> int * 'af sock_addr 156 val recvVecFrom' : ('af, dgram) sock * int * in_flags 157 -> Word8Vector.vector * 'sock_type sock_addr 158 val recvArrFrom' : ('af, dgram) sock * Word8ArraySlice.slice 159 * in_flags -> int * 'af sock_addr 160 val recvVecFromNB : ('af, dgram) sock * int 161 -> (Word8Vector.vector * 'sock_type sock_addr) option 162 val recvArrFromNB : ('af, dgram) sock * Word8ArraySlice.slice 163 -> (int * 'af sock_addr) option 164 val recvVecFromNB' : ('af, dgram) sock * int * in_flags 165 -> (Word8Vector.vector * 'sock_type sock_addr) option 166 val recvArrFromNB' : ('af, dgram) sock * Word8ArraySlice.slice 167 * in_flags -> (int * 'af sock_addr) option 168end; 169 170structure Socket :> SOCKET = 171struct 172 (* We don't really need an implementation for these. *) 173 (* TODO: We should really pull the definition of the sock type into a common structure so 174 it can be shared by the various socket structures. In fact it doesn't matter since the 175 unary constructor here is compiled as an identity so the underlying representation of 176 "SOCK x" will be the same as "x". *) 177 datatype ('af,'sock_type) sock = SOCK of OS.IO.iodesc 178 and dgram = DGRAM 179 and 'mode stream = STREAM 180 and passive = PASSIVE 181 and active = ACTIVE 182 183 local 184 val netCall: int * word -> word = RunCall.rtsCallFull2 "PolyNetworkGeneral" 185 in 186 fun doNetCall(i: int, arg:'a):'b = 187 RunCall.unsafeCast(netCall(i, RunCall.unsafeCast arg)) 188 end 189 190 structure AF = 191 struct 192 type addr_family = NetHostDB.addr_family 193 194 local 195 val doCall: int*unit -> (string * addr_family) list 196 = doNetCall 197 in 198 fun list () = doCall(11, ()) 199 end 200 201 fun toString (af: addr_family) = 202 let 203 val afs = list() 204 in 205 (* Do a linear search on the list - it's small. *) 206 case List.find (fn (_, af') => af=af') afs of 207 NONE => raise OS.SysErr("Missing address family", NONE) 208 | SOME (s, _) => s 209 end 210 211 fun fromString s = 212 let 213 val afs = list() 214 in 215 (* Do a linear search on the list - it's small. *) 216 case List.find (fn (s', _) => s=s') afs of 217 NONE => NONE 218 | SOME (_, af) => SOME af 219 end 220 end 221 222 structure SOCK = 223 struct 224 datatype sock_type = SOCKTYPE of int 225 226 local 227 val doCall: int*unit -> (string * sock_type) list 228 = doNetCall 229 in 230 fun list () = doCall(12, ()) 231 end 232 233 fun toString (sk: sock_type) = 234 let 235 val sks = list() 236 in 237 (* Do a linear search on the list - it's small. *) 238 case List.find (fn (_, sk') => sk=sk') sks of 239 NONE => raise OS.SysErr("Missing socket type", NONE) 240 | SOME (s, _) => s 241 end 242 243 fun fromString s = 244 let 245 val sks = list() 246 in 247 (* Do a linear search on the list - it's small. *) 248 case List.find (fn (s', _) => s=s') sks of 249 NONE => NONE 250 | SOME (_, sk) => SOME sk 251 end 252 253 (* We assume that both of these at least are in the table. *) 254 val stream = 255 case fromString "STREAM" of 256 NONE => raise OS.SysErr("Missing socket type", NONE) 257 | SOME s => s 258 259 val dgram = 260 case fromString "DGRAM" of 261 NONE => raise OS.SysErr("Missing socket type", NONE) 262 | SOME s => s 263 end 264 265 (* Socket addresses are implemented as strings. *) 266 datatype 'af sock_addr = SOCKADDR of Word8Vector.vector 267 268 (* Note: The definition did not make these equality type variables. 269 The assumption is probably that it works much like equality on 270 references. *) 271 fun sameAddr (SOCKADDR a, SOCKADDR b) = a = b 272 273 (* Many of these calls involve type variables. We have to use a cast to 274 get the types right. *) 275 local 276 val doCall = doNetCall 277 in 278 fun familyOfAddr (sa: 'af sock_addr) = doCall(39, RunCall.unsafeCast sa) 279 end 280 281 structure Ctl = 282 struct 283 local 284 val doCall1 = doNetCall 285 val doCall2 = doNetCall 286 in 287 fun getOpt (i:int) (SOCK s) = doCall1(i, s) 288 fun setOpt (i: int) (SOCK s, b: bool) = doCall2(i, (s, b)) 289 end 290 291 fun getDEBUG s = getOpt 18 s 292 and setDEBUG s = setOpt 17 s 293 and getREUSEADDR s = getOpt 20 s 294 and setREUSEADDR s = setOpt 19 s 295 and getKEEPALIVE s = getOpt 22 s 296 and setKEEPALIVE s = setOpt 21 s 297 and getDONTROUTE s = getOpt 24 s 298 and setDONTROUTE s = setOpt 23 s 299 and getBROADCAST s = getOpt 26 s 300 and setBROADCAST s = setOpt 25 s 301 and getOOBINLINE s = getOpt 28 s 302 and setOOBINLINE s = setOpt 27 s 303 and getERROR s = getOpt 34 s 304 and getATMARK s = getOpt 45 s 305 306 local 307 val doCall1 = doNetCall 308 val doCall2 = doNetCall 309 in 310 fun getSNDBUF (SOCK s) = doCall1(30, s) 311 fun setSNDBUF (SOCK s, i: int) = doCall2(29, (s, i)) 312 fun getRCVBUF (SOCK s) = doCall1(32, s) 313 fun setRCVBUF (SOCK s, i: int) = doCall2(31, (s, i)) 314 fun getTYPE (SOCK s) = SOCK.SOCKTYPE(doCall1(33, s)) 315 316 fun getNREAD (SOCK s) = doCall1(44, s) 317 318 fun getLINGER (SOCK s): Time.time option = 319 let 320 val lTime = doCall1(36, s) 321 in 322 if lTime < 0 then NONE else SOME(Time.fromSeconds(LargeInt.fromInt lTime)) 323 end 324 325 fun setLINGER (SOCK s, NONE) = 326 ( 327 doCall2(35, (s, ~1)) 328 ) 329 | setLINGER (SOCK s, SOME t) = 330 let 331 val lTime = LargeInt.toInt(Time.toSeconds t) 332 in 333 if lTime < 0 334 then raise OS.SysErr("Invalid time", NONE) 335 else doCall2(35, (s, lTime)) 336 end 337 end 338 339 local 340 val doCall = doNetCall 341 in 342 fun getPeerName (SOCK s): 'af sock_addr = RunCall.unsafeCast(doCall(37, s)) 343 344 fun getSockName (SOCK s): 'af sock_addr = RunCall.unsafeCast(doCall(38, s)) 345 end 346 end (* Ctl *) 347 348 349 (* Run an operation in non-blocking mode. This catches EWOULDBLOCK and returns NONE, 350 otherwise returns SOME result. Other exceptions are passed back as normal. *) 351 val nonBlockingCall = LibraryIOSupport.nonBlocking 352 353 local 354 val doCall = doNetCall 355 in 356 fun accept (SOCK s) = RunCall.unsafeCast(doCall (46, s)) 357 end 358 359 local 360 val doCall = doNetCall 361 fun acc sock = doCall (58, RunCall.unsafeCast sock) 362 in 363 fun acceptNB sock = RunCall.unsafeCast(nonBlockingCall acc sock) 364 end 365 366 local 367 val doCall = doNetCall 368 in 369 fun bind (SOCK s, a) = doCall (47, RunCall.unsafeCast (s, a)) 370 end 371 372 local 373 val doCall = doNetCall 374 in 375 fun connect (SOCK s, a) = doCall (48, RunCall.unsafeCast (s, a)) 376 end 377 378 local 379 val doCall = doNetCall 380 fun connct sa = doCall (59, RunCall.unsafeCast sa) 381 in 382 fun connectNB (SOCK s, a) = 383 case nonBlockingCall connct (s,a) of SOME () => true | NONE => false 384 end 385 386 fun listen (SOCK s, b) = 387 doNetCall (49, (s, b)) 388 389 (* We use the normal "close" for streams. *) 390 local 391 val doCall = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 392 in 393 fun close (SOCK strm): unit = doCall(7, strm, 0) 394 end 395 396 datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS 397 398 local 399 val doCall = doNetCall 400 in 401 fun shutdown (SOCK s, mode) = 402 let 403 val m = 404 case mode of 405 NO_RECVS => 1 406 | NO_SENDS => 2 407 | NO_RECVS_OR_SENDS => 3 408 in 409 doCall (50, (s, m)) 410 end 411 end 412 413 (* The IO descriptor is the underlying socket. *) 414 fun ioDesc (SOCK s) = s; 415 416 type out_flags = {don't_route : bool, oob : bool} 417 type in_flags = {peek : bool, oob : bool} 418 type 'a buf = {buf : 'a, i : int, sz : int option} 419 420 local 421 val nullOut = { don't_route = false, oob = false } 422 and nullIn = { peek = false, oob = false } 423 424 (* This implementation is copied from the implementation of 425 Word8Array.array and Word8Vector.vector. *) 426 type address = LibrarySupport.address 427 datatype vector = datatype LibrarySupport.Word8Array.vector 428 datatype array = datatype LibrarySupport.Word8Array.array 429 val wordSize = LibrarySupport.wordSize 430 431 (* Send the data from an array or vector. Note: the underlying RTS function 432 deals with the special case of sending a single byte vector where the 433 "address" is actually the byte itself. *) 434 local 435 val doCall = doNetCall 436 fun doSend i a = doCall (i, a) 437 in 438 fun send (SOCK sock, base: address, offset: int, length: int, rt: bool, oob: bool): int = 439 doSend 51 (sock, base, offset, length, rt, oob) 440 441 fun sendNB (SOCK sock, base: address, offset: int, length: int, rt: bool, oob: bool): int option = 442 nonBlockingCall (doSend 60) (sock, base, offset, length, rt, oob) 443 end 444 445 local 446 (* Although the underlying call returns the number of bytes written the 447 ML functions now return unit. *) 448 val doCall = doNetCall 449 fun doSendTo i a = doCall (i, a) 450 in 451 fun sendTo (SOCK sock, addr, base: address, offset: int, length: int, rt: bool, oob: bool): unit = 452 doSendTo 52 (RunCall.unsafeCast(sock, addr, base, offset, length, rt, oob)) 453 454 fun sendToNB (SOCK sock, addr, base: address, offset: int, length: int, rt: bool, oob: bool): bool = 455 case nonBlockingCall (doSendTo 61) (RunCall.unsafeCast(sock, addr, base, offset, length, rt, oob)) of 456 NONE => false | SOME _ => true 457 end 458 459 local 460 val doCall = doNetCall 461 fun doRecv i a = doCall (i, a) 462 in 463 (* Receive the data into an array. *) 464 fun recv (SOCK sock, base: address, offset: int, length: int, peek: bool, oob: bool): int = 465 doRecv 53 (RunCall.unsafeCast(sock, base, offset, length, peek, oob)) 466 467 fun recvNB (SOCK sock, base: address, offset: int, length: int, peek: bool, oob: bool): int option = 468 nonBlockingCall (doRecv 62) (RunCall.unsafeCast(sock, base, offset, length, peek, oob)) 469 end 470 471 local 472 val doCall = doNetCall 473 fun doRecvFrom i a = doCall (i, a) 474 in 475 fun recvFrom (SOCK sock, base: address, offset: int, length: int, peek: bool, oob: bool) = 476 RunCall.unsafeCast(doRecvFrom 54 (RunCall.unsafeCast (sock, base, offset, length, peek, oob))) 477 478 fun recvFromNB (SOCK sock, base: address, offset: int, length: int, peek: bool, oob: bool) = 479 RunCall.unsafeCast(nonBlockingCall (doRecvFrom 63) (RunCall.unsafeCast (sock, base, offset, length, peek, oob))) 480 end 481 in 482 fun sendVec' (sock, slice: Word8VectorSlice.slice, {don't_route, oob}) = 483 let 484 val (v, i, length) = Word8VectorSlice.base slice 485 in 486 send(sock, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 487 end 488 and sendVec (sock, vbuff) = sendVec'(sock, vbuff, nullOut) 489 490 fun sendVecNB' (sock, slice: Word8VectorSlice.slice, {don't_route, oob}) = 491 let 492 val (v, i, length) = Word8VectorSlice.base slice 493 in 494 sendNB(sock, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 495 end 496 and sendVecNB (sock, vbuff) = sendVecNB'(sock, vbuff, nullOut) 497 498 fun sendArr' (sock, slice: Word8ArraySlice.slice, {don't_route, oob}) = 499 let 500 val (Array(_, v), i, length) = Word8ArraySlice.base slice 501 in 502 send(sock, v, i, length, don't_route, oob) 503 end 504 and sendArr (sock, vbuff) = sendArr'(sock, vbuff, nullOut) 505 506 fun sendArrNB' (sock, slice: Word8ArraySlice.slice, {don't_route, oob}) = 507 let 508 val (Array(_, v), i, length) = Word8ArraySlice.base slice 509 in 510 sendNB(sock, v, i, length, don't_route, oob) 511 end 512 and sendArrNB (sock, vbuff) = sendArrNB'(sock, vbuff, nullOut) 513 514 fun sendVecTo' (sock, addr, slice: Word8VectorSlice.slice, {don't_route, oob}) = 515 let 516 val (v, i, length) = Word8VectorSlice.base slice 517 in 518 sendTo(sock, addr, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 519 end 520 and sendVecTo (sock, addr, vbuff) = sendVecTo'(sock, addr, vbuff, nullOut) 521 522 fun sendVecToNB' (sock, addr, slice: Word8VectorSlice.slice, {don't_route, oob}) = 523 let 524 val (v, i, length) = Word8VectorSlice.base slice 525 in 526 sendToNB(sock, addr, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 527 end 528 and sendVecToNB (sock, addr, vbuff) = sendVecToNB'(sock, addr, vbuff, nullOut) 529 530 fun sendArrTo' (sock, addr, slice: Word8ArraySlice.slice, {don't_route, oob}) = 531 let 532 val (Array(_, v), i, length) = Word8ArraySlice.base slice 533 in 534 sendTo(sock, addr, v, i, length, don't_route, oob) 535 end 536 and sendArrTo (sock, addr, vbuff) = sendArrTo'(sock, addr, vbuff, nullOut) 537 538 fun sendArrToNB' (sock, addr, slice: Word8ArraySlice.slice, {don't_route, oob}) = 539 let 540 val (Array(_, v), i, length) = Word8ArraySlice.base slice 541 in 542 sendToNB(sock, addr, v, i, length, don't_route, oob) 543 end 544 and sendArrToNB (sock, addr, vbuff) = sendArrToNB'(sock, addr, vbuff, nullOut) 545 546 fun recvArr' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 547 let 548 val (Array(_, v), i, length) = Word8ArraySlice.base slice 549 in 550 recv(sock, v, i, length, peek, oob) 551 end 552 and recvArr (sock, vbuff) = recvArr'(sock, vbuff, nullIn) 553 554 fun recvArrNB' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 555 let 556 val (Array(_, v), i, length) = Word8ArraySlice.base slice 557 in 558 recvNB(sock, v, i, length, peek, oob) 559 end 560 and recvArrNB (sock, vbuff) = recvArrNB'(sock, vbuff, nullIn) 561 562 (* To receive a vector first create an array, read into it, 563 then copy it to a new vector. This does involve extra copying 564 but it probably doesn't matter too much. *) 565 fun recvVec' (sock, size, flags) = 566 let 567 val arr = Word8Array.array(size, 0w0); 568 val recvd = recvArr'(sock, Word8ArraySlice.full arr, flags) 569 in 570 Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME recvd)) 571 end 572 and recvVec (sock, size) = recvVec'(sock, size, nullIn) 573 574 fun recvVecNB' (sock, size, flags) = 575 let 576 val arr = Word8Array.array(size, 0w0); 577 in 578 case recvArrNB'(sock, Word8ArraySlice.full arr, flags) of 579 NONE => NONE 580 | SOME recvd => SOME(Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME recvd))) 581 end 582 and recvVecNB (sock, size) = recvVecNB'(sock, size, nullIn) 583 584 fun recvArrFrom' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 585 let 586 val (Array(_, v), i, length) = Word8ArraySlice.base slice 587 in 588 recvFrom(sock, v, i, length, peek, oob) 589 end 590 and recvArrFrom (sock, abuff) = recvArrFrom'(sock, abuff, nullIn) 591 592 593 fun recvArrFromNB' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 594 let 595 val (Array(_, v), i, length) = Word8ArraySlice.base slice 596 in 597 recvFromNB(sock, v, i, length, peek, oob) 598 end 599 and recvArrFromNB (sock, abuff) = recvArrFromNB'(sock, abuff, nullIn) 600 601 fun recvVecFrom' (sock, size, flags) = 602 let 603 val arr = Word8Array.array(size, 0w0); 604 val (rcvd, addr) = 605 recvArrFrom'(sock, Word8ArraySlice.full arr, flags) 606 in 607 (Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME rcvd)), addr) 608 end 609 and recvVecFrom (sock, size) = recvVecFrom'(sock, size, nullIn) 610 611 fun recvVecFromNB' (sock, size, flags) = 612 let 613 val arr = Word8Array.array(size, 0w0); 614 in 615 case recvArrFromNB'(sock, Word8ArraySlice.full arr, flags) of 616 NONE => NONE 617 | SOME (rcvd, addr) => 618 SOME (Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME rcvd)), addr) 619 end 620 and recvVecFromNB (sock, size) = recvVecFromNB'(sock, size, nullIn) 621 622 end 623 624 (* "select" call. *) 625 datatype sock_desc = SOCKDESC of OS.IO.iodesc 626 fun sockDesc (SOCK sock) = SOCKDESC sock (* Create a socket descriptor from a socket. *) 627 fun sameDesc (SOCKDESC a, SOCKDESC b) = a = b 628 629 local 630 (* The underlying call takes three arrays and updates them with the sockets that are 631 in the appropriate state. It sets inactive elements to ~1. *) 632 val doIo: int * (OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector * Time.time) -> 633 OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector 634 = doNetCall 635 in 636 fun sys_select_block(rds, wrs, exs) = doIo(64, (rds, wrs, exs, Time.zeroTime)) 637 fun sys_select_poll(rds, wrs, exs) = doIo(65, (rds, wrs, exs, Time.zeroTime)) 638 (* The time parameter for a wait is the absolute time when the timeout expires. *) 639 and sys_select_wait (rds, wrs, exs, t) = doIo(66, (rds, wrs, exs, t)) 640 end 641 642 fun select { rds: sock_desc list, wrs : sock_desc list, exs : sock_desc list, timeout: Time.time option } : 643 { rds: sock_desc list, wrs : sock_desc list, exs : sock_desc list } = 644 let 645 fun sockDescToDesc(SOCKDESC sock) = sock 646 (* Create the initial vectors. *) 647 val rdVec: OS.IO.iodesc Vector.vector = Vector.fromList(map sockDescToDesc rds) 648 val wrVec: OS.IO.iodesc Vector.vector = Vector.fromList(map sockDescToDesc wrs) 649 val exVec: OS.IO.iodesc Vector.vector = Vector.fromList(map sockDescToDesc exs) 650 open Time 651 val (rdResult, wrResult, exResult) = 652 (* Do the approriate select. *) 653 case timeout of 654 NONE => sys_select_block(rdVec, wrVec, exVec) 655 | SOME t => if t <= Time.zeroTime 656 then sys_select_poll(rdVec, wrVec, exVec) 657 else sys_select_wait(rdVec, wrVec, exVec, t + Time.now()); 658 (* Function to create the results. *) 659 fun getResults v = Vector.foldr (fn (sd, l) => SOCKDESC sd :: l) [] v 660 in 661 (* Convert the results. *) 662 { rds = getResults rdResult, wrs = getResults wrResult, exs = getResults exResult } 663 end 664 665end; 666 667local 668 (* Install the pretty printer for Socket.AF.addr_family 669 This must be done outside 670 the structure if we use opaque matching. *) 671 fun printAF _ _ x = PolyML.PrettyString(Socket.AF.toString x) 672 fun printSK _ _ x = PolyML.PrettyString(Socket.SOCK.toString x) 673 fun prettySocket _ _ (_: ('a, 'b) Socket.sock) = PolyML.PrettyString "?" 674in 675 val () = PolyML.addPrettyPrinter printAF 676 val () = PolyML.addPrettyPrinter printSK 677 val () = PolyML.addPrettyPrinter prettySocket 678end; 679