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