This file is indexed.

/usr/share/gauche-0.9/0.9.5/lib/srfi-106.scm is in gauche 0.9.5-1.

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
;;;
;;; 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 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, AI_ALL and AI_ADDRCONFIG may not be defined
;;     even if ipv6 is available (e.g. NetBSD, MinGW32).
(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*
  (global-variable-ref 'gauche.net 'AI_ADDRCONFIG 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)
;; NB: MSG_WAITALL may not be defined (e.g. MinGW32).
(define-constant *msg-waitall*
  (global-variable-ref 'gauche.net 'MSG_WAITALL 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)))