1;;; 2;;; srfi-106 - socket interface 3;;; 4 5;; NB: Test for srfi-106 is in ext/net. 6 7(define-module srfi-106 8 (use gauche.uvector) 9 (use gauche.net :prefix net:) 10 (export make-client-socket make-server-socket socket? call-with-socket 11 socket-input-port socket-output-port 12 socket-merge-flags socket-purge-flags 13 socket-accept socket-send socket-recv socket-shutdown socket-close 14 *af-unspec* *af-inet* *af-inet6* 15 *sock-stream* *sock-dgram* 16 *ai-canonname* *ai-numerichost* 17 *ai-v4mapped* *ai-all* *ai-addrconfig* 18 *ipproto-ip* *ipproto-tcp* *ipproto-udp* 19 *msg-none* *msg-peek* *msg-oob* *msg-waitall* 20 *shut-rd* *shut-wr* *shut-rdwr* 21 address-family socket-domain address-info 22 ip-protocol message-type shutdown-method)) 23(select-module srfi-106) 24 25;; 26;; Constants and flag operations 27;; 28(define-constant *af-inet* net:AF_INET) 29(define-constant *af-inet6* net:AF_INET6) 30(define-constant *af-unspec* net:AF_UNSPEC) 31 32(define-macro (address-family name) 33 (ecase (unwrap-syntax name) 34 [(inet) *af-inet*] 35 [(inet6) *af-inet6*] 36 [(unspec) *af-unspec*])) 37 38(define-constant *sock-stream* net:SOCK_STREAM) 39(define-constant *sock-dgram* net:SOCK_DGRAM) 40 41(define-macro (socket-domain name) 42 (ecase (unwrap-syntax name) 43 [(stream) *sock-stream*] 44 [(datagram) *sock-dgram*])) 45 46(define-constant *ai-canonname* net:AI_CANONNAME) 47(define-constant *ai-numerichost* net:AI_NUMERICHOST) 48;; NB: AI_V4MAPPED, AI_ALL and AI_ADDRCONFIG may not be defined 49;; even if ipv6 is available (e.g. NetBSD, MinGW32). 50(define-constant *ai-v4mapped* 51 (global-variable-ref 'gauche.net 'AI_V4MAPPED 0)) 52(define-constant *ai-all* 53 (global-variable-ref 'gauche.net 'AI_ALL 0)) 54(define-constant *ai-addrconfig* 55 (global-variable-ref 'gauche.net 'AI_ADDRCONFIG 0)) 56 57(define-macro (address-info . names) 58 (define (lookup name) 59 (ecase (unwrap-syntax name) 60 [(canoname) *ai-canonname*] 61 [(numerichost) *ai-numerichost*] 62 [(v4mapped) *ai-v4mapped*] 63 [(all) *ai-all*] 64 [(addrconfig) *ai-addrconfig*])) 65 (apply logior (map lookup names))) 66 67(define-constant *ipproto-ip* net:IPPROTO_IP) 68(define-constant *ipproto-tcp* net:IPPROTO_TCP) 69(define-constant *ipproto-udp* net:IPPROTO_UDP) 70 71(define-macro (ip-protocol name) 72 (ecase (unwrap-syntax name) 73 [(ip) *ipproto-ip*] 74 [(tcp) *ipproto-tcp*] 75 [(udp) *ipproto-udp*])) 76 77(define-constant *msg-none* 0) 78(define-constant *msg-peek* net:MSG_PEEK) 79(define-constant *msg-oob* net:MSG_OOB) 80;; NB: MSG_WAITALL may not be defined (e.g. MinGW32). 81(define-constant *msg-waitall* 82 (global-variable-ref 'gauche.net 'MSG_WAITALL 0)) 83 84(define-macro (message-type . names) 85 (define (lookup name) 86 (ecase (unwrap-syntax name) 87 [(none) *msg-none*] 88 [(peek) *msg-peek*] 89 [(oob) *msg-oob*] 90 [(wait-all) *msg-waitall*])) 91 (apply logior (map lookup names))) 92 93(define-constant *shut-rd* net:SHUT_RD) 94(define-constant *shut-wr* net:SHUT_WR) 95(define-constant *shut-rdwr* net:SHUT_RDWR) 96 97(define-macro (shutdown-method . names) 98 (define (lookup name) 99 (ecase (unwrap-syntax name) 100 [(read) *shut-rd*] 101 [(write) *shut-wr*])) 102 (apply logior (map lookup names))) 103 104(define (socket-merge-flags . flags) (apply logior flags)) 105(define (socket-purge-flags base-flag . flags) 106 (logand base-flag (lognot (apply logior flags)))) 107 108;; 109;; Constructors 110;; 111(define (make-client-socket node service 112 :optional 113 (ai-family *af-inet*) 114 (ai-socktype *sock-stream*) 115 (ai-flags (socket-merge-flags *ai-v4mapped* 116 *ai-addrconfig*)) 117 (ai-protocol *ipproto-ip*)) 118 (assume-type node <string>) 119 (assume-type service <string>) 120 (cond-expand 121 [gauche.net.ipv6 122 (let1 ais (net:sys-getaddrinfo node service 123 (make net:<sys-addrinfo> 124 :flags ai-flags 125 :family ai-family 126 :socktype ai-socktype 127 :protocol ai-protocol)) 128 (or (any (^[ai] (guard (e [else #f]) 129 (net:make-client-socket (~ ai'addr)))) 130 ais) 131 ;; If we're here, attempts to connect to every ais failed. 132 ;; TODO: We might want to keep one of the errors for better msg 133 (error "couldn't connect to ~a:~a" node service)))] 134 [else 135 ;; We should handle other options, but this path is rarely used, 136 ;; only for ipv6-less platforms. 137 (let1 addrs (net:make-sockaddrs node service ai-protocol) 138 (or (any (^[addr] (guard (e [else #f]) 139 (net:make-client-socket addr))) 140 addrs) 141 (error "couldn't connect to ~a:~a" node service)))])) 142 143(define (make-server-socket service 144 :optional 145 (ai-family *af-inet*) 146 (ai-socktype *sock-stream*) 147 (ai-protocol *ipproto-ip*)) 148 (assume-type service <string>) 149 (cond-expand 150 [gauche.net.ipv6 151 (let1 ais (net:sys-getaddrinfo #f service 152 (make net:<sys-addrinfo> 153 :flags 0 154 :family ai-family 155 :socktype ai-socktype 156 :protocol ai-protocol)) 157 (or (any (^[ai] (guard (e [else #f]) 158 (net:make-server-socket (~ ai'addr)))) 159 ais) 160 ;; If we're here, attempts to bind every ais failed. 161 ;; TODO: We might want to keep one of the errors for better msg 162 (error "couldn't create a server socket at service `~a'" service)))] 163 [else 164 ;; We should handle other options, but this path is rarely used, 165 ;; only for ipv6-less platforms. 166 (let1 addrs (net:make-sockaddrs #f service ai-protocol) 167 (or (any (^[addr] (guard (e [else #f]) 168 (net:make-server-socket addr))) 169 addrs) 170 (error "couldn't create a server socket at service `~a'" service)))] 171 )) 172 173;; 174;; Communication 175;; 176 177(define (socket-send socket u8v :optional (flags *msg-none*)) 178 (assume-type u8v <u8vector>) 179 (net:socket-send socket u8v flags)) 180 181(define (socket-recv socket size :optional (flags *msg-none*)) 182 (let1 buf (make-u8vector size) 183 (let1 n (net:socket-recv! socket buf flags) 184 (if (< n size) 185 (uvector-alias <u8vector> buf 0 n) ; returns #u8() when conn. closed 186 buf)))) 187 188;; 189;; Miscellaneous 190;; 191 192(define (socket? x) (is-a? x net:<socket>)) 193(define socket-accept net:socket-accept) 194(define socket-shutdown net:socket-shutdown) 195(define socket-input-port net:socket-input-port) 196(define socket-output-port net:socket-output-port) 197(define socket-close net:socket-close) 198 199(define (call-with-socket socket proc) 200 (unwind-protect (proc socket) 201 (socket-close socket))) 202 203 204 205