Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/usocket-usocket-20250208033134/option.lisp

Kind	Covered	All	%
expression	0	129	0.0
branch	0	2	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: USOCKET -*-

2

;;;; SOCKET-OPTION, a high-level socket option get/set framework

3

4

;;;; See LICENSE for licensing information.

5

6

(in-package :usocket)

7

8

;; put here because option.lisp is for native backend only

9

(defparameter *backend* :native)

10

11

;;; Interface definition

12

13

(defgeneric socket-option (socket option &key)

14

(:documentation

15

"Get a socket's internal options"))

16

17

(defgeneric (setf socket-option) (new-value socket option &key)

18

(:documentation

19

"Set a socket's internal options"))

20

21

;;; Handling of wrong type of arguments

22

23

(defmethod socket-option ((socket usocket) (option t) &key)

24

(error 'type-error :datum option :expected-type 'keyword))

25

26

(defmethod (setf socket-option) (new-value (socket usocket) (option t) &key)

27

(declare (ignore new-value))

28

(socket-option socket option))

29

30

(defmethod socket-option ((socket usocket) (option symbol) &key)

31

(if (keywordp option)

32

(error 'unimplemented :feature option :context 'socket-option)

33

(error 'type-error :datum option :expected-type 'keyword)))

34

35

(defmethod (setf socket-option) (new-value (socket usocket) (option symbol) &key)

36

(declare (ignore new-value))

37

(socket-option socket option))

38

39

;;; Socket option: RECEIVE-TIMEOUT (SO_RCVTIMEO)

40

41

(defmethod socket-option ((usocket stream-usocket)

42

(option (eql :receive-timeout)) &key)

43

(declare (ignorable option))

44

(let ((socket (socket usocket)))

45

(declare (ignorable socket))

46

#+abcl

47

() ; TODO

48

#+allegro

49

() ; TODO

50

#+clisp

51

(socket:socket-options socket :so-rcvtimeo)

52

#+clozure

53

(ccl:stream-input-timeout socket)

54

#+cmu

55

(lisp::fd-stream-timeout (socket-stream usocket))

56

#+(or ecl clasp)

57

(sb-bsd-sockets:sockopt-receive-timeout socket)

58

#+lispworks

59

(get-socket-receive-timeout socket)

60

#+mcl

61

() ; TODO

62

#+mocl

63

() ; unknown

64

#+sbcl

65

(sb-impl::fd-stream-timeout (socket-stream usocket))

66

#+scl

67

())) ; TODO

68

69

(defmethod (setf socket-option) (new-value (usocket stream-usocket)

70

                                            (option (eql :receive-timeout)) &key)

71

(declare (type number new-value) (ignorable new-value option))

72

(let ((socket (socket usocket))

73

(timeout new-value))

74

(declare (ignorable socket timeout))

75

#+abcl

76

() ; TODO

77

#+allegro

78

() ; TODO

79

#+clisp

80

(socket:socket-options socket :so-rcvtimeo timeout)

81

#+clozure

82

(setf (ccl:stream-input-timeout socket) timeout)

83

#+cmu

84

(setf (lisp::fd-stream-timeout (socket-stream usocket))

85

(coerce timeout 'integer))

86

#+(or ecl clasp)

87

(setf (sb-bsd-sockets:sockopt-receive-timeout socket) timeout)

88

#+lispworks

89

(set-socket-receive-timeout socket timeout)

90

#+mcl

91

() ; TODO

92

#+mocl

93

() ; unknown

94

#+sbcl

95

(setf (sb-impl::fd-stream-timeout (socket-stream usocket))

96

(coerce timeout 'single-float))

97

#+scl

98

() ; TODO

99

new-value))

100

101

;;; Socket option: SEND-TIMEOUT (SO_SNDTIMEO)

102

103

(defmethod socket-option ((usocket stream-usocket)

104

(option (eql :send-timeout)) &key)

105

(declare (ignorable option))

106

(let ((socket (socket usocket)))

107

(declare (ignorable socket))

108

#+abcl

109

() ; TODO

110

#+allegro

111

() ; TODO

112

#+clisp

113

(socket:socket-options socket :so-sndtimeo)

114

#+clozure

115

(ccl:stream-output-timeout socket)

116

#+cmu

117

(lisp::fd-stream-timeout (socket-stream usocket))

118

#+(or ecl clasp)

119

(sb-bsd-sockets:sockopt-send-timeout socket)

120

#+lispworks

121

(get-socket-send-timeout socket)

122

#+mcl

123

() ; TODO

124

#+mocl

125

() ; unknown

126

#+sbcl

127

(sb-impl::fd-stream-timeout (socket-stream usocket))

128

#+scl

129

())) ; TODO

130

131

(defmethod (setf socket-option) (new-value (usocket stream-usocket)

132

                                            (option (eql :send-timeout)) &key)

133

(declare (type number new-value) (ignorable new-value option))

134

(let ((socket (socket usocket))

135

(timeout new-value))

136

(declare (ignorable socket timeout))

137

#+abcl

138

() ; TODO

139

#+allegro

140

() ; TODO

141

#+clisp

142

(socket:socket-options socket :so-sndtimeo timeout)

143

#+clozure

144

(setf (ccl:stream-output-timeout socket) timeout)

145

#+cmu

146

(setf (lisp::fd-stream-timeout (socket-stream usocket))

147

(coerce timeout 'integer))

148

#+(or ecl clasp)

149

(setf (sb-bsd-sockets:sockopt-send-timeout socket) timeout)

150

#+lispworks

151

(set-socket-send-timeout socket timeout)

152

#+mcl

153

() ; TODO

154

#+mocl

155

() ; unknown

156

#+sbcl

157

(setf (sb-impl::fd-stream-timeout (socket-stream usocket))

158

(coerce timeout 'single-float))

159

#+scl

160

() ; TODO

161

new-value))

162

163

;;; Socket option: REUSE-ADDRESS (SO_REUSEADDR), for TCP server

164

165

(defmethod socket-option ((usocket stream-server-usocket)

166

(option (eql :reuse-address)) &key)

167

(declare (ignorable option))

168

(let ((socket (socket usocket)))

169

(declare (ignorable socket))

170

#+abcl

171

() ; TODO

172

#+allegro

173

() ; TODO

174

#+clisp

175

(int->bool (socket:socket-options socket :so-reuseaddr))

176

#+clozure

177

(int->bool (get-socket-option-reuseaddr socket))

178

#+cmu

179

() ; TODO

180

#+lispworks

181

(get-socket-reuse-address socket)

182

#+mcl

183

() ; TODO

184

#+mocl

185

() ; unknown

186

#+(or ecl sbcl clasp)

187

(sb-bsd-sockets:sockopt-reuse-address socket)

188

#+scl

189

())) ; TODO

190

191

(defmethod (setf socket-option) (new-value (usocket stream-server-usocket)

192

                                            (option (eql :reuse-address)) &key)

193

(declare (type boolean new-value) (ignorable new-value option))

194

(let ((socket (socket usocket)))

195

(declare (ignorable socket))

196

#+abcl

197

() ; TODO

198

#+allegro

199

(socket:set-socket-options socket option new-value)

200

#+clisp

201

(socket:socket-options socket :so-reuseaddr (bool->int new-value))

202

#+clozure

203

(set-socket-option-reuseaddr socket (bool->int new-value))

204

#+cmu

205

() ; TODO

206

#+lispworks

207

(set-socket-reuse-address socket new-value)

208

#+mcl

209

() ; TODO

210

#+mocl

211

() ; unknown

212

#+(or ecl sbcl clasp)

213

(setf (sb-bsd-sockets:sockopt-reuse-address socket) new-value)

214

#+scl

215

() ; TODO

216

new-value))

217

218

;;; Socket option: BROADCAST (SO_BROADCAST), for UDP client

219

220

(defmethod socket-option ((usocket datagram-usocket)

221

(option (eql :broadcast)) &key)

222

(declare (ignorable option))

223

(let ((socket (socket usocket)))

224

(declare (ignorable socket))

225

#+abcl

226

() ; TODO

227

#+allegro

228

() ; TODO

229

#+clisp

230

(int->bool (socket:socket-options socket :so-broadcast))

231

#+clozure

232

(int->bool (get-socket-option-broadcast socket))

233

#+cmu

234

() ; TODO

235

#+(or ecl clasp)

236

() ; TODO

237

#+lispworks

238

(int->bool (get-socket-broadcast socket))

239

#+mcl

240

() ; TODO

241

#+mocl

242

() ; unknown

243

#+sbcl

244

(sb-bsd-sockets:sockopt-broadcast socket)

245

#+scl

246

())) ; TODO

247

248

(defmethod (setf socket-option) (new-value (usocket datagram-usocket)

249

                                            (option (eql :broadcast)) &key)

250

(declare (type boolean new-value)

251

(ignorable new-value option))

252

(let ((socket (socket usocket)))

253

(declare (ignorable socket))

254

#+abcl

255

() ; TODO

256

#+allegro

257

(socket:set-socket-options socket option new-value)

258

#+clisp

259

(socket:socket-options socket :so-broadcast (bool->int new-value))

260

#+clozure

261

(set-socket-option-broadcast socket (bool->int new-value))

262

#+cmu

263

() ; TODO

264

#+(or ecl clasp)

265

() ; TODO

266

#+lispworks

267

(set-socket-broadcast socket (bool->int new-value))

268

#+mcl

269

() ; TODO

270

#+mocl

271

() ; unknown

272

#+sbcl

273

(setf (sb-bsd-sockets:sockopt-broadcast socket) new-value)

274

#+scl

275

() ; TODO

276

new-value))

277

278

;;; Socket option: TCP-NODELAY (TCP_NODELAY), for TCP client

279

280

(defmethod socket-option ((usocket stream-usocket)

281

(option (eql :tcp-no-delay)) &key)

282

(declare (ignorable option))

283

(socket-option usocket :tcp-nodelay))

284

285

(defmethod socket-option ((usocket stream-usocket)

286

(option (eql :tcp-nodelay)) &key)

287

(declare (ignorable option))

288

(let ((socket (socket usocket)))

289

(declare (ignorable socket))

290

#+abcl

291

() ; TODO

292

#+allegro

293

() ; TODO

294

#+clisp

295

(int->bool (socket:socket-options socket :tcp-nodelay))

296

#+clozure

297

(int->bool (get-socket-option-tcp-nodelay socket))

298

#+cmu

299

()

300

#+(or ecl clasp)

301

(sb-bsd-sockets::sockopt-tcp-nodelay socket)

302

#+lispworks

303

(int->bool (get-socket-tcp-nodelay socket))

304

#+mcl

305

() ; TODO

306

#+mocl

307

() ; unknown

308

#+sbcl

309

(sb-bsd-sockets::sockopt-tcp-nodelay socket)

310

#+scl

311

())) ; TODO

312

313

(defmethod (setf socket-option) (new-value (usocket stream-usocket)

314

                                            (option (eql :tcp-no-delay)) &key)

315

(declare (ignorable option))

316

(setf (socket-option usocket :tcp-nodelay) new-value))

317

318

(defmethod (setf socket-option) (new-value (usocket stream-usocket)

319

                                            (option (eql :tcp-nodelay)) &key)

320

(declare (type boolean new-value)

321

(ignorable new-value option))

322

(let ((socket (socket usocket)))

323

(declare (ignorable socket))

324

#+abcl

325

() ; TODO

326

#+allegro

327

(socket:set-socket-options socket :no-delay new-value)

328

#+clisp

329

(socket:socket-options socket :tcp-nodelay (bool->int new-value))

330

#+clozure

331

(set-socket-option-tcp-nodelay socket (bool->int new-value))

332

#+cmu

333

()

334

#+(or ecl clasp)

335

(setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)

336

#+lispworks

337

(progn

338

#-(or lispworks4 lispworks5.0)

339

(comm::set-socket-tcp-nodelay socket new-value)

340

#+(or lispworks4 lispworks5.0)

341

(set-socket-tcp-nodelay socket (bool->int new-value)))

342

#+mcl

343

() ; TODO

344

#+mocl

345

() ; unknown

346

#+sbcl

347

(setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)

348

#+scl

349

() ; TODO

350

new-value))

351

352

;;; Socket option: TCP-KEEPALIVE (SO_KEEPALIVE)

353

354

(defmethod socket-option ((usocket stream-usocket)

355

(option (eql :tcp-keepalive)) &key)

356

(declare (ignorable option))

357

(let ((socket (socket usocket)))

358

(declare (ignorable socket))

359

#+abcl

360

() ; TODO

361

#+allegro

362

() ; TODO

363

#+clisp

364

() ; TODO

365

#+clozure

366

(int->bool (get-socket-option-keep-alive socket))

367

#+cmu

368

()

369

#+(or ecl clasp)

370

(sb-bsd-sockets::sockopt-keep-alive socket)

371

#+lispworks

372

(int->bool (get-socket-keepalive socket))

373

#+mcl

374

() ; TODO

375

#+mocl

376

() ; unknown

377

#+sbcl

378

(sb-bsd-sockets:sockopt-keep-alive socket)

379

#+scl

380

())) ; TODO

381

382

(defmethod (setf socket-option) (new-value (usocket stream-usocket)

383

                                            (option (eql :tcp-keepalive)) &key)

384

(declare (type boolean new-value)

385

(ignorable new-value option))

386

(let ((socket (socket usocket)))

387

(declare (ignorable socket))

388

#+abcl

389

() ; TODO

390

#+allegro

391

() ; TODO

392

#+clisp

393

() ; TODO

394

#+clozure

395

(set-socket-option-keep-alive socket (bool->int new-value))

396

#+cmu

397

()

398

#+(or ecl clasp)

399

(setf (sb-bsd-sockets::sockopt-keep-alive socket) new-value)

400

#+lispworks

401

(set-socket-keepalive socket (bool->int new-value))

402

#+mcl

403

() ; TODO

404

#+mocl

405

() ; unknown

406

#+sbcl

407

(setf (sb-bsd-sockets:sockopt-keep-alive socket) new-value)

408

#+scl

409

() ; TODO

410

new-value))

411

412

(eval-when (:load-toplevel :execute)

413

(export 'socket-option))