net.l (10184B)
1 # 04feb13abu 2 # (c) Software Lab. Alexander Burger 3 4 # (port ['T] 'cnt|(cnt . cnt) ['var]) -> cnt 5 (code 'doPort 2) 6 push X 7 push Y 8 push Z 9 ld X E 10 ld Y (E CDR) # Y on args 11 ld Z SOCK_STREAM # Type defaults to TCP 12 ld E (Y) # Eval first arg 13 eval 14 cmp E TSym # 'T'? 15 if eq # Yes 16 ld Z SOCK_DGRAM # Type UDP 17 ld Y (Y CDR) # Eval next arg 18 ld E (Y) 19 eval 20 end 21 cc socket(AF_INET6 Z 0) # Create socket 22 nul4 # OK? 23 js ipSocketErrX # No 24 ld C A # Keep socket in C 25 call closeOnExecAX 26 ld A 0 # Socket option "off" 27 st4 (Buf) # Store into 'optval' 28 cc setsockopt(C IPPROTO_IPV6 IPV6_V6ONLY Buf 4) # "Not only IPv6" option 29 nul4 # OK? 30 js ipV6onlyErrX # No 31 ld B 0 # Clear socket structure 32 mset (Addr) SOCKADDR_IN6 33 ld A AF_INET6 34 st2 (Addr SIN6_FAMILY) 35 ld B 0 # Clear sin6_addr 36 mset (Addr SIN6_ADDR) 16 # "::" (16 null-bytes) 37 cnt E # Single port-argument? 38 if nz # Yes 39 shr E 4 # Port zero? 40 if nz # No 41 ld A 1 # Socket option "on" 42 st4 (Buf) # Store into 'optval' 43 cc setsockopt(C SOL_SOCKET SO_REUSEADDR Buf 4) # "Reuse socket" option 44 nul4 # OK? 45 js ipReuseaddrErrX # No 46 end 47 push 0 # <S> No range limit 48 else 49 atom E # Port range? 50 jnz argErrEX # No 51 ld A (E CDR) # Get second port 52 ld E (E) # First port 53 shr E 4 # Range start 54 shr A 4 # Normalize second port 55 push A # <S> Range limit 56 end 57 do 58 cc htons(E) # Convert port to network order 59 st2 (Addr SIN6_PORT) # Store as port 60 cc bind(C Addr SOCKADDR_IN6) # Try to bind socket 61 nul4 # OK? 62 while s # No 63 inc E # Next port in range 64 cmp E (S) # Exceeded limit? 65 if gt # Yes 66 cc close(C) # Close socket 67 jmp ipBindErrX 68 end 69 loop 70 add S I # Drop range limit 71 cmp Z SOCK_STREAM # TCP socket? 72 if eq # Yes 73 cc listen(C 5) # Mark as server socket 74 nul4 # OK? 75 if s # No 76 cc close(C) # Close socket 77 jmp ipListenErrX 78 end 79 end 80 ld Z C # Keep socket in Z 81 ld Y (Y CDR) # Eval 'var' 82 ld E (Y) 83 eval 84 cmp E Nil # Any? 85 if ne # Yes 86 ld A SOCKADDR_IN6 # Structure size 87 st4 (Buf) # Store into 'namelen' 88 cc getsockname(Z Addr Buf) # Get socket name 89 nul4 # OK? 90 if s # No 91 cc close(Z) # Close socket 92 jmp ipGetsocknameErrX 93 end 94 call needVarEX # Need variable 95 ld2 (Addr SIN6_PORT) # Get port 96 cc ntohs(A) # Convert to host byte order 97 shl A 4 # Make short number 98 or A CNT 99 ld (E) A # Store in variable 100 end 101 ld E Z # Get socket 102 shl E 4 # Make short number 103 or E CNT 104 pop Z 105 pop Y 106 pop X 107 ret 108 109 (code 'tcpAcceptA_FE) 110 ld E A # Save socket in E 111 call nonblockingA_A # Set socket to non-blocking 112 push A # <S> Old socket status flags 113 ld C 200 # Maximally 20 seconds 114 do 115 ld A SOCKADDR_IN6 # Structure size 116 st4 (Buf) # Store into 'addrlen' 117 cc accept(E Addr Buf) # Accept connection 118 nul4 # OK? 119 if ns # Yes 120 xchg A (S) # Save new socket, retrieve flags 121 cc fcntl(E F_SETFL A) # Restore socket status flags 122 ? (<> *TargetOS "Linux") # Non-Linux (BSD sockets)? 123 cc fcntl((S) F_SETFL 0) # Yes: Set new socket to non-blocking 124 = 125 sub S (%% INET6_ADDRSTRLEN) # Allocate name buffer 126 cc inet_ntop(AF_INET6 &(Addr SIN6_ADDR) S INET6_ADDRSTRLEN) 127 ld E S 128 call mkStrE_E # Make transient symbol 129 ld (Adr) E # Store in '*Adr' 130 add S (%% INET6_ADDRSTRLEN) # Drop buffer 131 ld A (S) # Get socket 132 call initInFileA_A # Init input file 133 ld A (S) 134 call initOutFileA_A # and output file 135 pop E # Get new socket 136 shl E 4 # Make short number 137 or E CNT # Return 'nz' 138 ret 139 end 140 cc usleep(100000) # Sleep 100 milliseconds 141 dec C # Done? 142 until z # Yes 143 cc fcntl(E F_SETFL pop) # Restore socket status flags 144 setz # Return 'z' 145 ret 146 147 # (accept 'cnt) -> cnt | NIL 148 (code 'doAccept 2) 149 push X 150 ld X E 151 ld E ((E CDR)) # Eval socket descriptor 152 call evCntEX_FE 153 ld A E # Accept connection 154 call tcpAcceptA_FE # OK? 155 ldz E Nil # No 156 pop X 157 ret 158 159 # (listen 'cnt1 ['cnt2]) -> cnt | NIL 160 (code 'doListen 2) 161 push X 162 push Y 163 push Z 164 ld X E 165 ld Y (E CDR) # Y on args 166 call evCntXY_FE # Eval 'cnt1' 167 ld Z E # Keep socket descriptor in Z 168 ld Y (Y CDR) # Next arg 169 ld E (Y) 170 eval # Eval 'cnt2' 171 cmp E Nil # Given? 172 ldz Y -1 # No timeout 173 if ne # Yes 174 call xCntEX_FE # Milliseconds 175 ld Y E 176 end 177 do 178 ld C Z # Socket descriptor 179 ld E Y # Milliseconds 180 call waitFdCEX_A # Wait for events 181 ld E Nil # Preload NIL 182 null A # Timeout? 183 while nz # No 184 ld A Z # Accept connection 185 call tcpAcceptA_FE # OK? 186 until nz # Yes 187 pop Z 188 pop Y 189 pop X 190 ret 191 192 # (host 'any) -> sym 193 (code 'doHost 2) 194 push Z 195 ld E ((E CDR)) # Eval IP address 196 call evSymE_E 197 sub S I # 'lst' buffer 198 call bufStringE_SZ # Write to stack buffer 199 cc getaddrinfo(S 0 0 Z) # Get address info 200 ld S Z # Drop buffer 201 pop Z # Get 'lst' into Z 202 ld E Nil # Preset return value 203 nul4 # Address valid? 204 if z # Yes 205 sub S (%% NI_MAXHOST) # <S> Hostname buffer 206 ld C Z # Get 'lst' 207 do 208 nulp C # Any? 209 while nz # Yes 210 ld4 (C AI_ADDRLEN) 211 cc getnameinfo((C AI_ADDR) A S NI_MAXHOST 0 0 NI_NAMEREQD) 212 nul4 # OK? 213 if z # Yes 214 ld E S 215 call mkStrE_E # Make transient symbol 216 break T 217 end 218 ld C (C AI_NEXT) # Try next 219 loop 220 add S (%% NI_MAXHOST) # Drop buffer 221 cc freeaddrinfo(Z) 222 end 223 pop Z 224 ret 225 226 # (connect 'any1 'any2) -> cnt | NIL 227 (code 'doConnect 2) 228 push X 229 push Y 230 push Z 231 ld X E 232 ld Y (E CDR) # Y on args 233 call evSymY_E # Eval host 234 ld Y (Y CDR) # Next arg 235 ld C SOCK_STREAM 236 call serverCEY_FE # Found server? 237 if z # Yes 238 ld Z E # Keep list in Z 239 do 240 nulp E # Any? 241 while nz # Yes 242 ld4 (E AI_SOCKTYPE) # Create socket 243 ld C A 244 ld4 (E AI_FAMILY) 245 cc socket(A C 0) 246 nul4 # OK? 247 if ns # Yes 248 ld Y A # Keep socket in Y 249 ld4 (E AI_ADDRLEN) 250 cc connect(Y (E AI_ADDR) A) # Try to connect 251 nul4 # OK? 252 if z # Yes 253 ld A Y 254 call closeOnExecAX 255 ld A Y # Get socket 256 call initInFileA_A # Init input file 257 ld A Y 258 call initOutFileA_A # and output file 259 ld E Y # Return socket 260 shl E 4 # Make short number 261 or E CNT 262 jmp 80 263 end 264 cc close(Y) # Close socket 265 end 266 ld E (E AI_NEXT) # Try next 267 loop 268 ld E Nil # Return NIL 269 80 cc freeaddrinfo(Z) 270 end 271 pop Z 272 pop Y 273 pop X 274 ret 275 276 (code 'serverCEY_FE) 277 link 278 push E # <L I> Host 279 link 280 sub S (%% ADDRINFO) # <S> Hints 281 ld B 0 # Clear hints 282 mset (S) ADDRINFO 283 ld A AF_UNSPEC # Accept IPv4 and IPv6 284 st4 (S AI_FAMILY) # Store into 'ai_family' 285 ld A C # Get type 286 st4 (S AI_SOCKTYPE) # Store into 'ai_socktype' 287 call evSymY_E # Eval service 288 call bufStringE_SZ # Write to stack buffer 289 push Z # Save pointer to hints 290 ld E (L I) # Get host 291 call bufStringE_SZ # Write to stack buffer 292 sub S I # 'lst' buffer 293 cc getaddrinfo(&(S I) &(Z I) (Z) S) # Get address info 294 pop E # Into 'lst' 295 ld S (Z) # Clean up 296 add S (%% ADDRINFO) 297 nul4 # Address valid -> 'z' 298 ldnz E Nil 299 drop 300 ret 301 302 # (udp 'any1 'any2 'any3) -> any 303 # (udp 'cnt) -> any 304 (code 'doUdp 2) 305 push X 306 push Y 307 push Z 308 sub S UDPMAX # Allocate udp buffer 309 ld X E 310 ld Y (E CDR) # Y on args 311 ld E (Y) # Eval first 312 eval # 'any1' or 'cnt' 313 ld Y (Y CDR) # Next arg? 314 atom Y 315 if nz # No 316 call xCntEX_FE # 'cnt' 317 cc recv(E S UDPMAX 0) # Receive message 318 null A # OK? 319 js 10 # No 320 ld Z S # Buffer pointer 321 lea (BufEnd) (Z UDPMAX) # Calculate buffer end 322 ld (GetBinZ_FB) getUdpZ_FB # Set binary read function 323 ld (Extn) (ExtN) # Set external symbol offset 324 call binReadZ_FE # Read item? 325 if c # No 326 10 ld E Nil # Return NIL 327 end 328 else 329 call xSymE_E # Host 330 ld C SOCK_DGRAM 331 call serverCEY_FE # Found server? 332 if z # Yes 333 ld X E # Keep list in X 334 ld Y (Y CDR) # Next arg 335 ld E (Y) # Eval 'any2' 336 eval 337 ld Y E # Keep return value in Y 338 ld Z S # Buffer pointer 339 lea (BufEnd) (Z UDPMAX) # Calculate buffer end 340 ld (PutBinBZ) putUdpBZ # Set binary print function 341 ld (Extn) (ExtN) # Set external symbol offset 342 call binPrintEZ # Print item 343 ld E X # Get list 344 do 345 nulp E # Any? 346 while nz # Yes 347 ld4 (E AI_SOCKTYPE) # Create socket 348 ld C A 349 ld4 (E AI_FAMILY) 350 cc socket(A C 0) 351 nul4 # OK? 352 if ns # Yes 353 ld C A # Keep socket in C 354 sub Z S # Data length 355 ld4 (E AI_ADDRLEN) 356 cc sendto(C S Z 0 (E AI_ADDR) A) # Transmit message 357 cc close(C) # Close socket 358 ld E Y # Get return value 359 jmp 80 360 end 361 ld E (E AI_NEXT) # Try next 362 loop 363 ld E Nil # Return NIL 364 80 cc freeaddrinfo(X) 365 end 366 end 367 add S UDPMAX # Drop buffer 368 pop Z 369 pop Y 370 pop X 371 ret 372 373 (code 'getUdpZ_FB 0) 374 cmp Z (BufEnd) # End of buffer data? 375 jeq retc # Yes: Return 'c' 376 ld B (Z) # Next byte 377 add Z 1 # (nc) 378 ret 379 380 (code 'putUdpBZ 0) 381 cmp Z (BufEnd) # End of buffer data? 382 jeq udpOvflErr # Yes 383 ld (Z) B # Store byte 384 inc Z # Increment pointer 385 ret 386 387 # vi:et:ts=3:sw=3