1(* 2 Title: Standard Basis Library: Generic Sockets 3 Author: David Matthews 4 Copyright David Matthews 2000, 2005, 2015-16, 2019 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 eqtype addr_family (* = NetHostDB.addr_family *) (* This is a mess: NetHostDB depends on Socket. *) 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 171 where type ('af,'sock_type) sock = ('af,'sock_type) LibraryIOSupport.sock (* So we can use it elsewhere *) = 172struct 173 (* We don't really need an implementation for these. *) 174 datatype sock = datatype LibraryIOSupport.sock 175 176 datatype dgram = DGRAM 177 and 'mode stream = STREAM 178 and passive = PASSIVE 179 and active = ACTIVE 180 181 structure AF = 182 struct 183 type addr_family = int 184 185 val list: unit -> (string * addr_family) list = RunCall.rtsCallFull0 "PolyNetworkGetAddrList" 186 187 fun toString (af: addr_family) = 188 let 189 val afs = list() 190 in 191 (* Do a linear search on the list - it's small. *) 192 case List.find (fn (_, af') => af=af') afs of 193 NONE => raise OS.SysErr("Missing address family", NONE) 194 | SOME (s, _) => s 195 end 196 197 fun fromString s = 198 let 199 val afs = list() 200 in 201 (* Do a linear search on the list - it's small. *) 202 case List.find (fn (s', _) => s=s') afs of 203 NONE => NONE 204 | SOME (_, af) => SOME af 205 end 206 end 207 208 structure SOCK = 209 struct 210 datatype sock_type = SOCKTYPE of int 211 212 val list:unit -> (string * sock_type) list = RunCall.rtsCallFull0 "PolyNetworkGetSockTypeList" 213 214 fun toString (sk: sock_type) = 215 let 216 val sks = list() 217 in 218 (* Do a linear search on the list - it's small. *) 219 case List.find (fn (_, sk') => sk=sk') sks of 220 NONE => raise OS.SysErr("Missing socket type", NONE) 221 | SOME (s, _) => s 222 end 223 224 fun fromString s = 225 let 226 val sks = list() 227 in 228 (* Do a linear search on the list - it's small. *) 229 case List.find (fn (s', _) => s=s') sks of 230 NONE => NONE 231 | SOME (_, sk) => SOME sk 232 end 233 234 (* We assume that both of these at least are in the table. *) 235 val stream = 236 case fromString "STREAM" of 237 NONE => raise OS.SysErr("Missing socket type", NONE) 238 | SOME s => s 239 240 val dgram = 241 case fromString "DGRAM" of 242 NONE => raise OS.SysErr("Missing socket type", NONE) 243 | SOME s => s 244 end 245 246 (* Socket addresses are implemented as strings. *) 247 datatype sock_addr = datatype LibraryIOSupport.sock_addr 248 249 (* Note: The definition did not make these equality type variables. 250 The assumption is probably that it works much like equality on 251 references. *) 252 fun sameAddr (SOCKADDR a, SOCKADDR b) = a = b 253 254 local 255 (* Because this involves a type variable we need an extra function. *) 256 val doCall = RunCall.rtsCallFast1 "PolyNetworkGetFamilyFromAddress" 257 in 258 fun familyOfAddr (SOCKADDR sa) = doCall sa 259 end 260 261 262 (* Get the error state as an OS.syserror value. This is a SysWord.word value. *) 263 local 264 val sysGetError: OS.IO.iodesc -> SysWord.word = 265 RunCall.rtsCallFull1 "PolyNetworkGetSocketError" 266 in 267 fun getAndClearError(SOCK s): SysWord.word = sysGetError s 268 end 269 270 structure Ctl = 271 struct 272 local 273 val doGetOpt: int * OS.IO.iodesc -> int = RunCall.rtsCallFull2 "PolyNetworkGetOption" 274 val doSetOpt: int * OS.IO.iodesc * int -> unit = RunCall.rtsCallFull3 "PolyNetworkSetOption" 275 in 276 fun getOpt (i:int) (SOCK s) : int = doGetOpt(i, s) 277 fun setOpt (i: int) (SOCK s, v: int) = doSetOpt(i, s, v) 278 fun bv true = 1 | bv false = 0 279 end 280 281 fun getDEBUG s = getOpt 18 s <> 0 282 and setDEBUG(s, b) = setOpt 17 (s, bv b) 283 and getREUSEADDR s = getOpt 20 s <> 0 284 and setREUSEADDR(s, b) = setOpt 19 (s, bv b) 285 and getKEEPALIVE s = getOpt 22 s <> 0 286 and setKEEPALIVE(s, b) = setOpt 21 (s, bv b) 287 and getDONTROUTE s = getOpt 24 s <> 0 288 and setDONTROUTE(s, b) = setOpt 23 (s, bv b) 289 and getBROADCAST s = getOpt 26 s <> 0 290 and setBROADCAST(s, b) = setOpt 25 (s, bv b) 291 and getOOBINLINE s = getOpt 28 s <> 0 292 and setOOBINLINE(s, b) = setOpt 27 (s, bv b) 293 and getERROR s = getAndClearError s <> 0w0 294 and setSNDBUF(s, i: int) = setOpt 29 (s, i) 295 and getSNDBUF s = getOpt 30 s 296 and setRCVBUF(s, i: int) = setOpt 31 (s, i) 297 and getRCVBUF s = getOpt 32 s 298 and getTYPE s = SOCK.SOCKTYPE(getOpt 33 s) 299 300 local 301 val doGetOpt: OS.IO.iodesc -> bool = RunCall.rtsCallFull1 "PolyNetworkGetAtMark" 302 in 303 fun getATMARK (SOCK s) = doGetOpt s 304 end 305 306 local 307 val doGetNRead: OS.IO.iodesc -> int = RunCall.rtsCallFull1 "PolyNetworkBytesAvailable" 308 in 309 fun getNREAD (SOCK s) = doGetNRead s 310 end 311 312 local 313 val doSetLinger: OS.IO.iodesc * LargeInt.int -> unit = RunCall.rtsCallFull2 "PolyNetworkSetLinger" 314 val doGetLinger: OS.IO.iodesc -> LargeInt.int = RunCall.rtsCallFull1 "PolyNetworkGetLinger" 315 in 316 fun getLINGER (SOCK s): Time.time option = 317 let 318 val lTime = doGetLinger s (* Returns LargeInt.int *) 319 in 320 if lTime < 0 then NONE else SOME(Time.fromSeconds lTime) 321 end 322 323 fun setLINGER (SOCK s, NONE) = 324 ( 325 doSetLinger(s, ~1) 326 ) 327 | setLINGER (SOCK s, SOME t) = 328 let 329 val lTime = Time.toSeconds t 330 in 331 if lTime < 0 332 then raise OS.SysErr("Invalid time", NONE) 333 else doSetLinger(s, lTime) 334 end 335 end 336 337 local 338 val getPeer: OS.IO.iodesc -> Word8Vector.vector = RunCall.rtsCallFull1 "PolyNetworkGetPeerName" 339 in 340 fun getPeerName (SOCK s): 'af sock_addr = SOCKADDR(getPeer s) 341 end 342 343 local 344 val getSock: OS.IO.iodesc -> Word8Vector.vector = RunCall.rtsCallFull1 "PolyNetworkGetSockName" 345 in 346 fun getSockName (SOCK s): 'af sock_addr = SOCKADDR(getSock s) 347 end 348 end (* Ctl *) 349 350 351 (* "select" call. *) 352 datatype sock_desc = SOCKDESC of OS.IO.iodesc 353 fun sockDesc (SOCK sock) = SOCKDESC sock (* Create a socket descriptor from a socket. *) 354 fun sameDesc (SOCKDESC a, SOCKDESC b) = a = b 355 356 (* The underlying call takes three arrays and updates them with the sockets that are 357 in the appropriate state. It sets inactive elements to ~1. *) 358 val sysSelect: (OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector) * int -> 359 OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector * OS.IO.iodesc Vector.vector 360 = RunCall.rtsCallFull2 "PolyNetworkSelect" 361 362 fun select { rds: sock_desc list, wrs : sock_desc list, exs : sock_desc list, timeout: Time.time option } : 363 { rds: sock_desc list, wrs : sock_desc list, exs : sock_desc list } = 364 let 365 fun sockDescToDesc(SOCKDESC sock) = sock 366 (* Create the initial vectors. *) 367 val rdVec: OS.IO.iodesc Vector.vector = Vector.fromList(map sockDescToDesc rds) 368 val wrVec: OS.IO.iodesc Vector.vector = Vector.fromList(map sockDescToDesc wrs) 369 val exVec: OS.IO.iodesc Vector.vector = Vector.fromList(map sockDescToDesc exs) 370 371 (* As with OS.FileSys.poll we call the RTS to check the sockets for up to a second 372 and repeat until the time expires. *) 373 val finishTime = case timeout of NONE => NONE | SOME t => SOME(t + Time.now()) 374 375 val maxMilliSeconds = 1000 (* 1 second *) 376 377 fun doSelect() = 378 let 379 val timeToGo = 380 case finishTime of 381 NONE => maxMilliSeconds 382 | SOME finish => LargeInt.toInt(LargeInt.min(LargeInt.max(0, Time.toMilliseconds(finish-Time.now())), 383 LargeInt.fromInt maxMilliSeconds)) 384 385 val results as (rdResult, wrResult, exResult) = 386 sysSelect((rdVec, wrVec, exVec), timeToGo) 387 in 388 if timeToGo < maxMilliSeconds orelse Vector.length rdResult <> 0 389 orelse Vector.length wrResult <> 0 orelse Vector.length exResult <> 0 390 then results 391 else doSelect() 392 end 393 394 val (rdResult, wrResult, exResult) = doSelect() 395 396 (* Function to create the results. *) 397 fun getResults v = Vector.foldr (fn (sd, l) => SOCKDESC sd :: l) [] v 398 in 399 (* Convert the results. *) 400 { rds = getResults rdResult, wrs = getResults wrResult, exs = getResults exResult } 401 end 402 403 (* Run an operation in non-blocking mode. This catches EWOULDBLOCK and returns NONE, 404 otherwise returns SOME result. Other exceptions are passed back as normal. *) 405 val nonBlockingCall = LibraryIOSupport.nonBlocking 406 407 local 408 val accpt: OS.IO.iodesc -> OS.IO.iodesc * Word8Vector.vector = RunCall.rtsCallFull1 "PolyNetworkAccept" 409 in 410 fun acceptNB (SOCK sk) = 411 case nonBlockingCall accpt sk of 412 SOME (resSkt, resAddr) => SOME (SOCK resSkt, SOCKADDR resAddr) 413 | NONE => NONE 414 end 415 416 (* Blocking accept - keep trying until we get a result. *) 417 fun accept skt = 418 case acceptNB skt of 419 SOME result => result 420 | NONE => 421 ( 422 select{wrs=[], rds=[sockDesc skt], exs=[sockDesc skt], timeout=NONE}; 423 accept skt 424 ) 425 426 local 427 val doBindCall: OS.IO.iodesc * Word8Vector.vector -> unit = RunCall.rtsCallFull2 "PolyNetworkBind" 428 in 429 fun bind (SOCK s, SOCKADDR a) = doBindCall(s, a) 430 end 431 432 local 433 val connct: OS.IO.iodesc * Word8Vector.vector -> unit = RunCall.rtsCallFull2 "PolyNetworkConnect" 434 in 435 fun connectNB (SOCK s, SOCKADDR a) = 436 case nonBlockingCall connct (s,a) of SOME () => true | NONE => false 437 438 fun connect (sockAndAddr as (skt, _)) = 439 if connectNB sockAndAddr 440 then () 441 else 442 let 443 (* In Windows failure is indicated by the bit being set in 444 the exception set rather than the write set. *) 445 val _ = select{wrs=[sockDesc skt], rds=[], exs=[sockDesc skt], timeout=NONE} 446 val anyError = getAndClearError skt 447 val theError = LibrarySupport.syserrorFromWord anyError 448 in 449 if anyError = 0w0 450 then () 451 else raise OS.SysErr(OS.errorMsg theError, SOME theError) 452 end 453 454 end 455 456 local 457 val doListen: OS.IO.iodesc * int -> unit = RunCall.rtsCallFull2 "PolyNetworkListen" 458 in 459 fun listen (SOCK s, b) = doListen(s, b) 460 end 461 462 (* On Windows sockets and streams are different. *) 463 local 464 val doCall = RunCall.rtsCallFull1 "PolyNetworkCloseSocket" 465 in 466 fun close (SOCK strm): unit = doCall(strm) 467 end 468 469 datatype shutdown_mode = NO_RECVS | NO_SENDS | NO_RECVS_OR_SENDS 470 471 local 472 val doCall: OS.IO.iodesc * int -> unit = RunCall.rtsCallFull2 "PolyNetworkShutdown" 473 in 474 fun shutdown (SOCK s, mode) = 475 let 476 val m = 477 case mode of 478 NO_RECVS => 1 479 | NO_SENDS => 2 480 | NO_RECVS_OR_SENDS => 3 481 in 482 doCall(s, m) 483 end 484 end 485 486 (* The IO descriptor is the underlying socket. *) 487 fun ioDesc (SOCK s) = s; 488 489 type out_flags = {don't_route : bool, oob : bool} 490 type in_flags = {peek : bool, oob : bool} 491 type 'a buf = {buf : 'a, i : int, sz : int option} 492 493 local 494 val nullOut = { don't_route = false, oob = false } 495 and nullIn = { peek = false, oob = false } 496 497 (* This implementation is copied from the implementation of 498 Word8Array.array and Word8Vector.vector. *) 499 type address = LibrarySupport.address 500 datatype vector = datatype LibrarySupport.Word8Array.vector 501 datatype array = datatype LibrarySupport.Word8Array.array 502 val wordSize = LibrarySupport.wordSize 503 504 (* Send the data from an array or vector. *) 505 local 506 val doSend: OS.IO.iodesc * address * int * int * bool * bool -> int = 507 RunCall.rtsCallFull1 "PolyNetworkSend" 508 in 509 fun sendNB (SOCK sock, base: address, offset: int, length: int, rt: bool, oob: bool): int option = 510 nonBlockingCall doSend (sock, base, offset, length, rt, oob) 511 512 fun send (skt as SOCK sock, base, offset, length, rt, oob) = 513 ( 514 (* Wait until we can write. *) 515 select{wrs=[sockDesc skt], rds=[], exs=[], timeout=NONE}; 516 (* Send it. We should never get a WOULDBLOCK result so if we do we pass that back. *) 517 doSend (sock, base, offset, length, rt, oob) 518 ) 519 end 520 521 local 522 (* Although the underlying call returns the number of bytes written the 523 ML functions now return unit. *) 524 val doSend: OS.IO.iodesc * Word8Vector.vector * address * int * int * bool * bool -> int = 525 RunCall.rtsCallFull1 "PolyNetworkSendTo" 526 in 527 fun sendToNB (SOCK sock, SOCKADDR addr, base: address, offset, length, rt, oob): bool = 528 case nonBlockingCall doSend (sock, addr, base, offset, length, rt, oob) of 529 NONE => false | SOME _ => true 530 531 fun sendTo (skt as SOCK sock, SOCKADDR addr, base: address, offset, length, rt, oob): unit = 532 ( 533 (* Wait until we can write. *) 534 select{wrs=[sockDesc skt], rds=[], exs=[], timeout=NONE}; 535 doSend (sock, addr, base, offset, length, rt, oob); 536 () 537 ) 538 end 539 540 local 541 val doRecv: OS.IO.iodesc * address * int * int * bool * bool -> int = 542 RunCall.rtsCallFull1 "PolyNetworkReceive" 543 in 544 (* Receive the data into an array. *) 545 fun recvNB (SOCK sock, base: address, offset: int, length: int, peek: bool, oob: bool): int option = 546 nonBlockingCall doRecv (sock, base, offset, length, peek, oob) 547 548 fun recv (skt as SOCK sock, base, offset, length, rt, oob) = 549 ( 550 (* Wait until we can read. *) 551 select{wrs=[], rds=[sockDesc skt], exs=[], timeout=NONE}; 552 doRecv (sock, base, offset, length, rt, oob) 553 ) 554 end 555 556 local 557 val doRecvFrom: OS.IO.iodesc * address * int * int * bool * bool -> int * Word8Vector.vector = 558 RunCall.rtsCallFull1 "PolyNetworkReceiveFrom" 559 in 560 fun recvFromNB (SOCK sock, base, offset, length, peek, oob) = 561 case nonBlockingCall doRecvFrom (sock, base, offset, length, peek, oob) of 562 SOME(length, addr) => SOME(length, SOCKADDR addr) 563 | NONE => NONE 564 565 fun recvFrom (skt as SOCK sock, base, offset, length, peek, oob) = 566 ( 567 (* Wait until we can read. *) 568 select{wrs=[], rds=[sockDesc skt], exs=[], timeout=NONE}; 569 case doRecvFrom (sock, base, offset, length, peek, oob) of 570 (length, addr) => (length, SOCKADDR addr) 571 ) 572 end 573 in 574 fun sendVec' (sock, slice: Word8VectorSlice.slice, {don't_route, oob}) = 575 let 576 val (v, i, length) = Word8VectorSlice.base slice 577 in 578 send(sock, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 579 end 580 and sendVec (sock, vbuff) = sendVec'(sock, vbuff, nullOut) 581 582 fun sendVecNB' (sock, slice: Word8VectorSlice.slice, {don't_route, oob}) = 583 let 584 val (v, i, length) = Word8VectorSlice.base slice 585 in 586 sendNB(sock, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 587 end 588 and sendVecNB (sock, vbuff) = sendVecNB'(sock, vbuff, nullOut) 589 590 fun sendArr' (sock, slice: Word8ArraySlice.slice, {don't_route, oob}) = 591 let 592 val (Array(_, v), i, length) = Word8ArraySlice.base slice 593 in 594 send(sock, v, i, length, don't_route, oob) 595 end 596 and sendArr (sock, vbuff) = sendArr'(sock, vbuff, nullOut) 597 598 fun sendArrNB' (sock, slice: Word8ArraySlice.slice, {don't_route, oob}) = 599 let 600 val (Array(_, v), i, length) = Word8ArraySlice.base slice 601 in 602 sendNB(sock, v, i, length, don't_route, oob) 603 end 604 and sendArrNB (sock, vbuff) = sendArrNB'(sock, vbuff, nullOut) 605 606 fun sendVecTo' (sock, addr, slice: Word8VectorSlice.slice, {don't_route, oob}) = 607 let 608 val (v, i, length) = Word8VectorSlice.base slice 609 in 610 sendTo(sock, addr, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 611 end 612 and sendVecTo (sock, addr, vbuff) = sendVecTo'(sock, addr, vbuff, nullOut) 613 614 fun sendVecToNB' (sock, addr, slice: Word8VectorSlice.slice, {don't_route, oob}) = 615 let 616 val (v, i, length) = Word8VectorSlice.base slice 617 in 618 sendToNB(sock, addr, LibrarySupport.w8vectorAsAddress v, i + Word.toInt wordSize, length, don't_route, oob) 619 end 620 and sendVecToNB (sock, addr, vbuff) = sendVecToNB'(sock, addr, vbuff, nullOut) 621 622 fun sendArrTo' (sock, addr, slice: Word8ArraySlice.slice, {don't_route, oob}) = 623 let 624 val (Array(_, v), i, length) = Word8ArraySlice.base slice 625 in 626 sendTo(sock, addr, v, i, length, don't_route, oob) 627 end 628 and sendArrTo (sock, addr, vbuff) = sendArrTo'(sock, addr, vbuff, nullOut) 629 630 fun sendArrToNB' (sock, addr, slice: Word8ArraySlice.slice, {don't_route, oob}) = 631 let 632 val (Array(_, v), i, length) = Word8ArraySlice.base slice 633 in 634 sendToNB(sock, addr, v, i, length, don't_route, oob) 635 end 636 and sendArrToNB (sock, addr, vbuff) = sendArrToNB'(sock, addr, vbuff, nullOut) 637 638 fun recvArr' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 639 let 640 val (Array(_, v), i, length) = Word8ArraySlice.base slice 641 in 642 recv(sock, v, i, length, peek, oob) 643 end 644 and recvArr (sock, vbuff) = recvArr'(sock, vbuff, nullIn) 645 646 fun recvArrNB' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 647 let 648 val (Array(_, v), i, length) = Word8ArraySlice.base slice 649 in 650 recvNB(sock, v, i, length, peek, oob) 651 end 652 and recvArrNB (sock, vbuff) = recvArrNB'(sock, vbuff, nullIn) 653 654 (* To receive a vector first create an array, read into it, 655 then copy it to a new vector. This does involve extra copying 656 but it probably doesn't matter too much. *) 657 fun recvVec' (sock, size, flags) = 658 let 659 val arr = Word8Array.array(size, 0w0); 660 val recvd = recvArr'(sock, Word8ArraySlice.full arr, flags) 661 in 662 Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME recvd)) 663 end 664 and recvVec (sock, size) = recvVec'(sock, size, nullIn) 665 666 fun recvVecNB' (sock, size, flags) = 667 let 668 val arr = Word8Array.array(size, 0w0); 669 in 670 case recvArrNB'(sock, Word8ArraySlice.full arr, flags) of 671 NONE => NONE 672 | SOME recvd => SOME(Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME recvd))) 673 end 674 and recvVecNB (sock, size) = recvVecNB'(sock, size, nullIn) 675 676 fun recvArrFrom' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 677 let 678 val (Array(_, v), i, length) = Word8ArraySlice.base slice 679 in 680 recvFrom(sock, v, i, length, peek, oob) 681 end 682 and recvArrFrom (sock, abuff) = recvArrFrom'(sock, abuff, nullIn) 683 684 685 fun recvArrFromNB' (sock, slice: Word8ArraySlice.slice, {peek, oob}) = 686 let 687 val (Array(_, v), i, length) = Word8ArraySlice.base slice 688 in 689 recvFromNB(sock, v, i, length, peek, oob) 690 end 691 and recvArrFromNB (sock, abuff) = recvArrFromNB'(sock, abuff, nullIn) 692 693 fun recvVecFrom' (sock, size, flags) = 694 let 695 val arr = Word8Array.array(size, 0w0); 696 val (rcvd, addr) = 697 recvArrFrom'(sock, Word8ArraySlice.full arr, flags) 698 in 699 (Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME rcvd)), addr) 700 end 701 and recvVecFrom (sock, size) = recvVecFrom'(sock, size, nullIn) 702 703 fun recvVecFromNB' (sock, size, flags) = 704 let 705 val arr = Word8Array.array(size, 0w0); 706 in 707 case recvArrFromNB'(sock, Word8ArraySlice.full arr, flags) of 708 NONE => NONE 709 | SOME (rcvd, addr) => 710 SOME (Word8ArraySlice.vector(Word8ArraySlice.slice(arr, 0, SOME rcvd)), addr) 711 end 712 and recvVecFromNB (sock, size) = recvVecFromNB'(sock, size, nullIn) 713 714 end 715 716end; 717 718local 719 (* Install the pretty printer for Socket.AF.addr_family 720 This must be done outside 721 the structure if we use opaque matching. *) 722 fun printAF _ _ x = PolyML.PrettyString(Socket.AF.toString x) 723 fun printSK _ _ x = PolyML.PrettyString(Socket.SOCK.toString x) 724 fun prettySocket _ _ (_: ('a, 'b) Socket.sock) = PolyML.PrettyString "?" 725in 726 val () = PolyML.addPrettyPrinter printAF 727 val () = PolyML.addPrettyPrinter printSK 728 val () = PolyML.addPrettyPrinter prettySocket 729end; 730