1 /*
2 * Module for Raw Sockets / CLISP
3 * Fred Cohen, 2003-2004
4 * Don Cohen, 2003-2004
5 * Sam Steingold 2004-2012, 2017
6 * Bruno Haible 2004-2008
7 * <http://www.opengroup.org/onlinepubs/9699919799/basedefs/sys_socket.h.html>
8 */
9
10 #include "clisp.h"
11
12 #include "config.h"
13
14 #include <sys/time.h>
15 #include <time.h>
16 #include <sys/types.h>
17 #include <stdio.h>
18 #include <unistd.h>
19 #include <string.h> /* for memset(3) */
20 #include <stddef.h> /* for offsetof */
21 #include <sys/socket.h>
22 #include <netinet/in.h>
23 #include <arpa/inet.h>
24 #if defined(HAVE_LINUX_IF_PACKET_H)
25 # include <linux/if_packet.h>
26 #endif
27 #if defined(HAVE_ASM_TYPES_H)
28 # include <asm/types.h>
29 #endif
30 #if defined(HAVE_LINUX_NETLINK_H)
31 # include <linux/netlink.h>
32 #endif
33 #if defined(HAVE_NET_IF_H)
34 # include <net/if.h>
35 #endif
36 #if defined(HAVE_NETINET_IF_ETHER_H)
37 # include <netinet/if_ether.h>
38 #endif
39 #if defined(HAVE_SYS_IOCTL_H)
40 # include <sys/ioctl.h>
41 #endif
42 #if defined(HAVE_SYS_UN_H)
43 # include <sys/un.h>
44 #endif
45 #include <errno.h>
46 #if defined(HAVE_STROPS_H)
47 # include <stropts.h>
48 #endif
49 #if defined(HAVE_POLL_H)
50 # include <poll.h>
51 #endif
52 #if defined(HAVE_WINSOCK2_H) /* woe32 suckety sucks */
53 # include <winsock2.h>
54 # include <ws2tcpip.h>
55 # define SETSOCKOPT_ARG_T char*
56 # define READ(s,b,l) recv(s,b,l,0)
57 # define WRITE(s,b,l) send(s,b,l,0)
58 #else
59 # define READ read
60 # define WRITE write
61 #endif
62 #if defined(HAVE_NETDB_H)
63 # include <netdb.h>
64 #endif
65 #include <sys/uio.h>
66 #if defined(HAVE_IFADDRS_H)
67 # include <ifaddrs.h>
68 #endif
69 typedef SOCKET rawsock_t;
70
71 DEFMODULE(rawsock,"RAWSOCK")
72
73 /* ================== helpers ================== */
74 /* DANGER: the return value is invalidated by GC! only used by with_buffer_arg
75 <> *arg_: vector; on return: simple byte vector, to be pinned
76 > STACK_0, STACK_1: END & START -- removed
77 > prot: PROT_READ or PROT_READ_WRITE
78 < size: how many bytes to use
79 < pointer to the buffer start
80 removes 2 elements from STACK
81 can trigger GC */
parse_buffer_arg(gcv_object_t * arg_,size_t * size,int prot)82 static void* parse_buffer_arg (gcv_object_t *arg_, size_t *size, int prot) {
83 stringarg sa;
84 *arg_ = check_byte_vector(*arg_);
85 sa.offset = 0; sa.len = vector_length(*arg_);
86 sa.string = *arg_ = array_displace_check(*arg_,sa.len,&sa.offset);
87 test_vector_limits(&sa);
88 *size = sa.len;
89 { void *start_address =
90 (void*)(TheSbvector(sa.string)->data + sa.offset + sa.index);
91 handle_fault_range(prot,(aint)start_address,(aint)start_address + sa.len);
92 return start_address;
93 }
94 }
95 #define with_buffer_arg(_buffer,_arg_,_size,_prot,_code) do { \
96 void *_buffer = parse_buffer_arg(_arg_,_size,_prot); \
97 with_pinned_varobject(*_arg_,_code); \
98 } while(0)
99
100 /* DANGER: the return value is invalidated by GC! only used by with_sockaddr_arg
101 > type: the expected type
102 > arg: the argument
103 < size: the data size
104 > prot: PROT_READ or PROT_READ_WRITE
105 < returns the address of the data area
106 can trigger GC */
check_struct_data(object type,gcv_object_t * arg,socklen_t * size,int prot)107 static void* check_struct_data (object type, gcv_object_t *arg,
108 socklen_t *size, int prot) {
109 object vec = TheStructure(*arg = check_classname(*arg,type))->recdata[1];
110 *size = Sbvector_length(vec);
111 { void *start_address = (void*)(TheSbvector(vec)->data);
112 handle_fault_range(prot,(aint)start_address,(aint)start_address + *size);
113 return start_address;
114 }
115 }
116 #define with_sockaddr_arg(_ptr,_arg_,_size,_prot,_code) do { \
117 struct sockaddr* _ptr = \
118 (struct sockaddr*)check_struct_data(`RAWSOCK::SOCKADDR`, \
119 _arg_,_size,_prot); \
120 with_pinned_varobject(*_arg_,_code); \
121 } while(0)
122
123 /* check that the arg is a vector of byte vectors
124 > *arg_: vector
125 > STACK_0, STACK_1: START & END -- removed on success
126 < *arg_: may be modified (bad vector elements replaced with byte vectors)
127 < return: how many byte vectors arg contains
128 removes 2 elements from STACK if success (returns a positive value)
129 can trigger GC */
check_iovec_arg(gcv_object_t * arg_,uintL * offset)130 static int check_iovec_arg (gcv_object_t *arg_, uintL *offset) {
131 int ii;
132 stringarg sa;
133 *arg_ = check_vector(*arg_);
134 if (array_atype(*arg_) != Atype_T) return -1; /* cannot contain vectors */
135 sa.offset = 0; sa.len = vector_length(*arg_);
136 sa.string = array_displace_check(*arg_,sa.len,&sa.offset);
137 test_vector_limits(&sa);
138 *offset = sa.offset;
139 for (ii=*offset; ii<sa.len; ii++)
140 TheSvector(*arg_)->data[ii] =
141 check_byte_vector(TheSvector(*arg_)->data[ii]);
142 return sa.len;
143 }
144 #if !defined(HAVE_READV) /* emulate readv using read */
readv(rawsock_t sock,const struct iovec * iov,int len)145 static ssize_t readv (rawsock_t sock, const struct iovec *iov, int len) {
146 ssize_t retval = 0;
147 for (; len--; iov++)
148 retval += READ(sock,iov->iov_base,iov->iov_len);
149 return retval;
150 }
151 #endif
152 #if !defined(HAVE_WRITEV) /* emulate writev using write */
writev(rawsock_t sock,const struct iovec * iov,int len)153 static ssize_t writev (rawsock_t sock, const struct iovec *iov, int len) {
154 ssize_t retval = 0;
155 for (; len--; iov++)
156 retval += WRITE(sock,iov->iov_base,iov->iov_len);
157 return retval;
158 }
159 #endif
160 /* DANGER: the return value is invalidated by GC!
161 this must be called _after_ check_iovec_arg()
162 fill the iovec array from the vector of byte vectors
163 < vect: (vector (byte-vector))
164 < offset: starting offset into vect
165 < veclen: number of vect elements to put into buffer
166 < buffer: array of struct iovec of length veclen
167 < prot: PROT_READ or PROT_READ_WRITE
168 > buffer: filled in with data pointers of elements of vect */
169 #if defined(MULTITHREAD)
170 # define PIN_ARG_USE ,pcv
171 # define PIN_ARG_DECL , pinned_chain_t *pcv
172 # define PIN_DECL pinned_chain_t *pcv
173 # define PIN_INIT(len) pcv = (pinned_chain_t*)alloca((len)*sizeof(pinned_chain_t))
174 #else
175 # define PIN_ARG_USE
176 # define PIN_ARG_DECL
177 # define PIN_DECL
178 # define PIN_INIT(len)
179 #endif
fill_iovec(object vect,size_t offset,ssize_t veclen,struct iovec * buffer,int prot PIN_ARG_DECL)180 static void fill_iovec (object vect, size_t offset, ssize_t veclen,
181 struct iovec *buffer, int prot PIN_ARG_DECL) {
182 gcv_object_t *vec = TheSvector(vect)->data + offset;
183 ssize_t pos = veclen;
184 for (;pos--; buffer++, vec++) {
185 size_t len = vector_length(*vec);
186 uintL index = 0;
187 object data_vec = array_displace_check(*vec,len,&index);
188 pin_varobject_with_pc(&(pcv[pos]),data_vec);
189 buffer->iov_len = len;
190 buffer->iov_base= TheSbvector(data_vec)->data + index;
191 handle_fault_range(prot,(aint)buffer->iov_base,
192 (aint)buffer->iov_base + len);
193 }
194 }
195
196 DEFUN(RAWSOCK:SOCKADDR-FAMILY, sa) {
197 socklen_t size;
198 with_sockaddr_arg(sa,&STACK_0,&size,PROT_READ,
199 VALUES2(check_socket_domain_reverse(sa->sa_family),
200 fixnum(size)));
201 skipSTACK(1);
202 }
203 DEFUN(RAWSOCK::SOCKADDR-SLOT,&optional slot) {
204 /* return offset & size of the slot in SOCKADDR */
205 restart_sockaddr_slot:
206 if (missingp(STACK_0)) {
207 VALUES1(fixnum(sizeof(struct sockaddr)));
208 } else if (eq(STACK_0,`:FAMILY`)) {
209 struct sockaddr sa;
210 VALUES2(fixnum(offsetof(struct sockaddr,sa_family)),
211 fixnum(sizeof(sa.sa_family)));
212 } else if (eq(STACK_0,`:DATA`)) {
213 struct sockaddr sa;
214 VALUES2(fixnum(offsetof(struct sockaddr,sa_data)),
215 fixnum(sizeof(sa.sa_data)));
216 } else {
217 pushSTACK(NIL); /* no PLACE */
218 pushSTACK(STACK_1/*slot*/); /* TYPE-ERROR slot DATUM */
219 pushSTACK(`(MEMBER :FAMILY :DATA)`); /* TYPE-ERROR slot EXPECTED-TYPE */
220 pushSTACK(`RAWSOCK::SOCKADDR`); pushSTACK(STACK_2/*slot*/);
221 pushSTACK(TheSubr(subr_self)->name);
222 check_value(type_error,GETTEXT("~S: unknown slot ~S for ~S"));
223 STACK_0 = value1;
224 goto restart_sockaddr_slot;
225 }
226 skipSTACK(1);
227 }
228
229 /* can trigger GC */
make_sockaddr1(uintL size)230 static object make_sockaddr1 (uintL size) {
231 pushSTACK(allocate_bit_vector(Atype_8Bit,size));
232 funcall(`RAWSOCK::MAKE-SA`,1);
233 return value1;
234 }
235 #define make_sockaddr() make_sockaddr1(sizeof(struct sockaddr))
236
237 /* can trigger GC */
sockaddr_to_lisp(struct sockaddr * sa,uintL size)238 static object sockaddr_to_lisp (struct sockaddr *sa, uintL size) {
239 pushSTACK(data_to_sb8vector(sa,size));
240 funcall(`RAWSOCK::MAKE-SA`,1); return value1;
241 }
242 #define pushSTACK_sockaddr(sa) pushSTACK(sa ? sockaddr_to_lisp(sa,sizeof(*sa)) : NIL)
243
244 struct pos {
245 gcv_object_t *vector;
246 unsigned int position;
247 };
248 void coerce_into_bytes (void *arg, object element);
coerce_into_bytes(void * arg,object element)249 void coerce_into_bytes (void *arg, object element) {
250 struct pos * pos = (struct pos *)arg;
251 uint8 value = I_to_uint8(check_uint8(element));
252 TheSbvector(*(pos->vector))->data[pos->position++] = value;
253 }
254
255 DEFUN(RAWSOCK:MAKE-SOCKADDR,family &optional data) {
256 int family = check_socket_domain(STACK_1);
257 unsigned char *buffer;
258 size_t buffer_len, data_start = offsetof(struct sockaddr,sa_data);
259 struct pos arg;
260 if (missingp(STACK_0)) { /* standard size */
261 buffer_len = sizeof(struct sockaddr) - data_start;
262 } else if (posfixnump(STACK_0)) { /* integer data => as if sequence of 0 */
263 buffer_len = posfixnum_to_V(STACK_0);
264 } else { /* data should be a sequence */
265 pushSTACK(STACK_0); funcall(L(length),1);
266 buffer_len = I_to_uint32(value1);
267 }
268 pushSTACK(allocate_bit_vector(Atype_8Bit,data_start + buffer_len));
269 buffer = (unsigned char *)TheSbvector(STACK_0)->data;
270 begin_system_call();
271 memset(buffer,0,data_start + buffer_len);
272 end_system_call();
273 ((struct sockaddr*)buffer)->sa_family = family;
274 arg.vector = &(STACK_0); arg.position = data_start;
275 if (!missingp(STACK_1) && !posfixnump(STACK_1))
276 map_sequence(STACK_1/*data*/,coerce_into_bytes,(void*)&arg);
277 funcall(`RAWSOCK::MAKE-SA`,1);
278 skipSTACK(2);
279 }
280
281 /* ================== SIGPIPE handling ================== */
282 #define begin_sock_call() START_WRITING_TO_SUBPROCESS; begin_blocking_system_call()
283 #define end_sock_call() end_blocking_system_call(); STOP_WRITING_TO_SUBPROCESS
284
285 /* report error on the given socket or OS_error if socket<0 */
rawsock_error(int socket)286 static _Noreturn void rawsock_error (int socket) {
287 if (socket < 0) ANSIC_error();
288 begin_system_call(); {
289 int ecode = errno;
290 char *msg = strerror(ecode);
291 end_system_call();
292 pushSTACK(`RAWSOCK::RAWSOCK-ERROR`); /* error type */
293 pushSTACK(S(Kcode));
294 pushSTACK(fixnum(ecode)); funcall(`OS::ERRNO`,1); pushSTACK(value1);
295 pushSTACK(`:MESSAGE`); pushSTACK(safe_to_string(msg));
296 pushSTACK(`:SOCKET`); pushSTACK(fixnum(socket));
297 funcall(S(make_instance),7);
298 }
299 pushSTACK(value1); funcall(S(error),1);
300 NOTREACHED;
301 }
302
303 /* invoke system call C, place return value in R, report error on socket S */
304 #define SYSCALL(r,s,c) \
305 do { begin_sock_call(); r = c; end_sock_call(); \
306 if (r == -1) rawsock_error(s); \
307 } while(0)
308
309 /* ================== arpa/inet.h interface ================== */
310 /* Define even when the OS lacks the C functions; in that case,
311 we emulate the C functions. */
312 DEFUN(RAWSOCK:HTONL, num) {
313 uint32 arg = I_to_uint32(check_uint32(popSTACK()));
314 uint32 result;
315 #if defined(HAVE_HTONL) || defined(WIN32_NATIVE)
316 begin_system_call(); result = htonl(arg); end_system_call();
317 #else
318 union { struct { uint8 octet3; uint8 octet2; uint8 octet1; uint8 octet0; } o;
319 uint32 all;
320 }
321 word;
322 word.all = arg;
323 result = ((uint32)word.o.octet3 << 24) | ((uint32)word.o.octet2 << 16)
324 | ((uint32)word.o.octet1 << 8) | (uint32)word.o.octet0;
325 #endif
326 VALUES1(uint32_to_I(result));
327 }
328 DEFUN(RAWSOCK:NTOHL, num) {
329 uint32 arg = I_to_uint32(check_uint32(popSTACK()));
330 uint32 result;
331 #if defined(HAVE_NTOHL) || defined(WIN32_NATIVE)
332 begin_system_call(); result = ntohl(arg); end_system_call();
333 #else
334 union { struct { uint8 octet3; uint8 octet2; uint8 octet1; uint8 octet0; } o;
335 uint32 all;
336 }
337 word;
338 word.o.octet3 = (arg >> 24) & 0xff;
339 word.o.octet2 = (arg >> 16) & 0xff;
340 word.o.octet1 = (arg >> 8) & 0xff;
341 word.o.octet0 = arg & 0xff;
342 result = word.all;
343 #endif
344 VALUES1(uint32_to_I(result));
345 }
346 DEFUN(RAWSOCK:HTONS, num) {
347 uint16 arg = I_to_uint16(check_uint16(popSTACK()));
348 uint16 result;
349 #if defined(HAVE_HTONS) || defined(WIN32_NATIVE)
350 begin_system_call(); result = htons(arg); end_system_call();
351 #else
352 union { struct { uint8 octet1; uint8 octet0; } o;
353 uint16 all;
354 }
355 word;
356 word.all = arg;
357 result = ((uint16)word.o.octet1 << 8) | (uint16)word.o.octet0;
358 #endif
359 VALUES1(uint16_to_I(result));
360 }
361 DEFUN(RAWSOCK:NTOHS, num) {
362 uint16 arg = I_to_uint16(check_uint16(popSTACK()));
363 uint16 result;
364 #if defined(HAVE_NTOHS) || defined(WIN32_NATIVE)
365 begin_system_call(); result = ntohs(arg); end_system_call();
366 #else
367 union { struct { uint8 octet1; uint8 octet0; } o;
368 uint16 all;
369 }
370 word;
371 word.o.octet1 = (arg >> 8) & 0xff;
372 word.o.octet0 = arg & 0xff;
373 result = word.all;
374 #endif
375 VALUES1(uint16_to_I(result));
376 }
377 DEFUN(RAWSOCK:CONVERT-ADDRESS, family address) {
378 int family = check_socket_domain(STACK_1);
379 convert_address_restart:
380 if (stringp(STACK_0)) {
381 with_string_0(STACK_0,Symbol_value(S(utf_8)),ip_address,
382 { value1 = string_to_addr(ip_address); });
383 } else if (integerp(STACK_0)) {
384 switch (family) {
385 #if defined(HAVE_IPV6)
386 case AF_INET6: {
387 if (!((fixnump(STACK_0) && positivep(STACK_0)) /*socket.d:resolve_host*/
388 || (bignump(STACK_0) && positivep(STACK_0)
389 && Bignum_length(STACK_0)*sizeof(uintD)
390 <= sizeof(struct in6_addr))))
391 goto bad_address;
392 struct in6_addr addr;
393 UI_to_LEbytes(STACK_0,8*sizeof(struct in6_addr),(uintB*)&addr);
394 value1 = addr_to_string(family,(char*)&addr);
395 } break;
396 #endif
397 case AF_INET: {
398 uint32 ip_address;
399 UI_to_LEbytes(check_uint32(STACK_0),8*sizeof(uint32),
400 (uintB*)&ip_address);
401 value1 = addr_to_string(family,(char*)&ip_address);
402 } break;
403 default: value1 = NIL;
404 }
405 } else if (simple_bit_vector_p(Atype_8Bit,STACK_0)) {
406 value1 = addr_to_string(family,(char*)TheSbvector(STACK_0)->data);
407 } else bad_address: error_string_integer(STACK_0);
408 if (nullp(value1)) {
409 pushSTACK(NIL); /* no PLACE */
410 pushSTACK(STACK_1); /* domain */
411 pushSTACK(STACK_1); /* address */
412 pushSTACK(TheSubr(subr_self)->name);
413 check_value(error_condition,GETTEXT("~S: invalid address ~S for family ~S"));
414 STACK_0 = value1;
415 goto convert_address_restart;
416 }
417 skipSTACK(2); mv_count = 1;
418 }
419
420 /* ================== netdb.h interface ================== */
421 #if defined(HAVE_NETDB_H)
422 /* return RAWSOCK:PROTOCOL object in value1 */
protoent_to_protocol(struct protoent * pe)423 static Values protoent_to_protocol (struct protoent *pe) {
424 pushSTACK(asciz_to_string(pe->p_name,GLO(misc_encoding)));
425 push_string_array(pe->p_aliases);
426 pushSTACK(sint_to_I(pe->p_proto));
427 funcall(`RAWSOCK::MAKE-PROTOCOL`,3);
428 }
429 DEFUN(RAWSOCK:PROTOCOL, &optional protocol)
430 { /* interface to getprotobyname() et al
431 http://www.opengroup.org/onlinepubs/9699919799/functions/getprotoent.html */
432 object proto = popSTACK();
433 struct protoent *pe = NULL;
434 if (missingp(proto)) { /* get all protocols */
435 int count = 0;
436 begin_system_call();
437 # if defined(HAVE_SETPROTOENT) && defined(HAVE_GETPROTOENT) && defined(HAVE_ENDPROTOENT)
438 setprotoent(1);
439 while ((pe = getprotoent())) {
440 end_system_call();
441 protoent_to_protocol(pe); pushSTACK(value1); count++;
442 begin_system_call();
443 }
444 endprotoent();
445 # endif
446 end_system_call();
447 VALUES1(listof(count));
448 return;
449 } else if (sint_p(proto)) {
450 # if defined(HAVE_GETPROTOBYNUMBER) || defined(WIN32_NATIVE)
451 begin_system_call();
452 pe = getprotobynumber(I_to_sint(proto));
453 end_system_call();
454 # endif
455 } else if (stringp(proto)) {
456 # if defined(HAVE_GETPROTOBYNAME) || defined(WIN32_NATIVE)
457 with_string_0(proto,GLO(misc_encoding),protoz, {
458 begin_system_call();
459 pe = getprotobyname(protoz);
460 end_system_call();
461 });
462 # endif
463 } else error_string_integer(proto);
464 if (pe) protoent_to_protocol(pe);
465 else VALUES1(NIL);
466 }
467 /* --------------- */
468 /* return RAWSOCK:NETWORK object in value1 */
netent_to_network(struct netent * ne)469 static Values netent_to_network (struct netent *ne) {
470 pushSTACK(asciz_to_string(ne->n_name,GLO(misc_encoding)));
471 push_string_array(ne->n_aliases);
472 pushSTACK(sint_to_I(ne->n_addrtype));
473 pushSTACK(sint_to_I(ne->n_net));
474 funcall(`RAWSOCK::MAKE-NETWORK`,4);
475 }
476 DEFUN(RAWSOCK:NETWORK, &optional network type)
477 { /* interface to getnetbyname() et al
478 http://www.opengroup.org/onlinepubs/9699919799/functions/getnetent.html */
479 unsigned int type = check_uint_defaulted(popSTACK(),(unsigned int)-1);
480 object net = popSTACK();
481 struct netent *ne = NULL;
482 if (missingp(net)) { /* get all networks */
483 int count = 0;
484 # if defined(HAVE_SETNETENT) && defined(HAVE_GETNETENT) && defined(HAVE_ENDNETENT)
485 begin_system_call();
486 setnetent(1);
487 while ((ne = getnetent())) {
488 end_system_call();
489 if (type==(unsigned int)-1 || type==ne->n_addrtype) {
490 netent_to_network(ne); pushSTACK(value1); count++;
491 }
492 begin_system_call();
493 }
494 endnetent();
495 end_system_call();
496 # endif
497 VALUES1(listof(count));
498 return;
499 } else if (uint_p(net)) {
500 # if defined(HAVE_GETNETBYADDR)
501 begin_system_call();
502 ne = getnetbyaddr(I_to_uint(net),type);
503 end_system_call();
504 # endif
505 } else if (stringp(net)) {
506 # if defined(HAVE_GETNETBYNAME)
507 with_string_0(net,GLO(misc_encoding),netz, {
508 begin_system_call();
509 ne = getnetbyname(netz);
510 end_system_call();
511 });
512 # endif
513 } else error_string_integer(net);
514 if (ne) netent_to_network(ne);
515 else VALUES1(NIL);
516 }
517 #endif /* HAVE_NETDB_H */
518 /* ================== net/if.h interface ================== */
519 /* http://www.opengroup.org/onlinepubs/9699919799/basedefs/net_if.h.html */
520 #if defined(HAVE_NET_IF_H)
521 DEFUN(RAWSOCK:IF-NAME-INDEX, &optional what) {
522 if (missingp(STACK_0)) {
523 int count = 0;
524 # if defined(HAVE_IF_NAMEINDEX) && defined(HAVE_IF_FREENAMEINDEX)
525 struct if_nameindex *ifni;
526 begin_system_call();
527 if ((ifni = if_nameindex()) == NULL) ANSIC_error();
528 end_system_call();
529 for (; ifni[count].if_index; count++) {
530 pushSTACK(allocate_cons());
531 Car(STACK_0) = uint_to_I(ifni[count].if_index);
532 Cdr(STACK_0) = asciz_to_string(ifni[count].if_name,GLO(misc_encoding));
533 }
534 begin_system_call(); if_freenameindex(ifni); end_system_call();
535 # endif
536 VALUES1(listof(count));
537 } else if (uint_p(STACK_0)) {
538 # if defined(HAVE_IF_INDEXTONAME)
539 char name[IF_NAMESIZE];
540 begin_system_call();
541 if (NULL == if_indextoname(I_to_uint(STACK_0),name)) ANSIC_error();
542 end_system_call();
543 VALUES1(asciz_to_string(name,GLO(misc_encoding)));
544 # else
545 pushSTACK(TheSubr(subr_self)->name);
546 error(error_condition,GETTEXT("~S: no if_indextoname() at configure time"));
547 # endif
548 } else if (stringp(STACK_0)) {
549 # if defined(HAVE_IF_INDEXTONAME)
550 unsigned int idx;
551 with_string_0(STACK_0,GLO(misc_encoding),namez, {
552 begin_system_call();
553 if (0 == (idx = if_nametoindex(namez))) ANSIC_error();
554 end_system_call();
555 });
556 VALUES1(uint_to_I(idx));
557 # else
558 pushSTACK(TheSubr(subr_self)->name);
559 error(error_condition,GETTEXT("~S: no if_nametoindex() at configure time"));
560 # endif
561 } else error_string_integer(STACK_0);
562 skipSTACK(1);
563 }
564 #endif /* net/if.h */
565 /* ================== ifaddrs.h interface ================== */
566 #if defined(HAVE_NET_IF_H) && defined(HAVE_IFADDRS_H) && defined(HAVE_GETIFADDRS) && defined(HAVE_FREEIFADDRS)
567 DEFCHECKER(check_iff,prefix=IFF,bitmasks=both,default=(unsigned)~0, \
568 :UP BROADCAST DEBUG LOOPBACK \
569 POINTOPOINT NOTRAILERS RUNNING NOARP PROMISC ALLMULTI \
570 OACTIVE SIMPLEX LINK0 LINK1 LINK2 ALTPHYS POLLING PPROMISC \
571 MONITOR STATICARP NEEDSGIANT \
572 MASTER SLAVE MULTICAST PORTSEL AUTOMEDIA DYNAMIC LOWER-UP DORMANT)
573 DEFUN(RAWSOCK:IFADDRS,&key FLAGS-AND FLAGS-OR) {
574 struct ifaddrs *ifap;
575 int count = 0;
576 unsigned int flags_or = check_iff_of_list(popSTACK());
577 unsigned int flags_and = missingp(STACK_0) ? 0 : check_iff_of_list(STACK_0);
578 skipSTACK(1); /* drop flags_and */
579 begin_system_call();
580 if (-1==getifaddrs(&ifap)) ANSIC_error();
581 end_system_call();
582 for (; ifap; ifap=ifap->ifa_next)
583 if ((flags_or & ifap->ifa_flags)
584 && ((flags_and & ifap->ifa_flags) == flags_and)) {
585 pushSTACK(asciz_to_string(ifap->ifa_name,GLO(misc_encoding)));
586 pushSTACK(check_iff_to_list(ifap->ifa_flags));
587 pushSTACK_sockaddr(ifap->ifa_addr);
588 pushSTACK_sockaddr(ifap->ifa_netmask);
589 if (ifap->ifa_flags & IFF_BROADCAST)
590 if (ifap->ifa_flags & IFF_POINTOPOINT) {
591 pushSTACK(STACK_3); /* ifa_name */
592 pushSTACK(TheSubr(subr_self)->name);
593 error(error_condition,GETTEXT("~S: both IFF_BROADCAST and IFF_POINTOPOINT set for ~S"));
594 } else pushSTACK_sockaddr(ifap->ifa_broadaddr);
595 else if (ifap->ifa_flags & IFF_POINTOPOINT)
596 pushSTACK_sockaddr(ifap->ifa_dstaddr);
597 else pushSTACK(NIL);
598 pushSTACK(ifap->ifa_data ? allocate_fpointer(ifap->ifa_data) : NIL);
599 funcall(`RAWSOCK::MAKE-IFADDRS`,6);
600 pushSTACK(value1); count++;
601 }
602 begin_system_call(); freeifaddrs(ifap); end_system_call();
603 VALUES1(listof(count));
604 }
605 #endif /* ifaddrs.h */
606 /* ================== sys/socket.h interface ================== */
607 DEFCHECKER(check_socket_domain,prefix=AF,default=AF_UNSPEC, \
608 UNSPEC :UNIX LOCAL INET IMPLINK PUP CHAOS AX25 DATAKIT CCITT \
609 IPX NS ISO OSI ECMA APPLETALK NETROM BRIDGE ATMPVC X25 INET6 \
610 ROSE DECnet NETBEUI SECURITY :KEY NETLINK DLI LAT HYLINK BAN \
611 ROUTE PACKET ASH ECONET ATM ATMSVC SNA IRDA NETBIOS VOICEVIEW \
612 PPPOX WANPIPE BLUETOOTH FIREFOX CLUSTER 12844 NETDES)
613 DEFCHECKER(check_socket_type,prefix=SOCK,default=0, \
614 :STREAM DGRAM RAW RDM SEQPACKET PACKET)
615 DEFCHECKER(check_socket_protocol,default=0, \
616 IPPROTO-IP IPPROTO-IPV6 IPPROTO-ICMP IPPROTO-RAW IPPROTO-TCP \
617 IPPROTO-UDP IPPROTO-IGMP IPPROTO-IPIP IPPROTO-EGP IPPROTO-PUP \
618 IPPROTO-IDP IPPROTO-GGP IPPROTO-ND IPPROTO-HOPOPTS \
619 IPPROTO-ROUTING IPPROTO-FRAGMENT IPPROTO-ESP IPPROTO-AH \
620 IPPROTO-ICMPV6 IPPROTO-DSTOPTS IPPROTO-NONE \
621 IPPROTO-RSVP IPPROTO-GRE IPPROTO-PIM IPPROTO-COMP \
622 NSPROTO-IPX NSPROTO-SPX NSPROTO-SPXII \
623 NETLINK-ROUTE NETLINK-USERSOCK NETLINK-FIREWALL NETLINK-INET-DIAG \
624 NETLINK-NFLOG NETLINK-XFRM NETLINK-SELINUX NETLINK-ISCSI \
625 NETLINK-AUDIT NETLINK-FIB-LOOKUP NETLINK-CONNECTOR \
626 NETLINK-NETFILTER NETLINK-IP6-FW NETLINK-DNRTMSG \
627 NETLINK-KOBJECT-UEVENT NETLINK-GENERIC NETLINK-SCSITRANSPORT \
628 NETLINK-ECRYPTFS \
629 ETH-P-LOOP ETH-P-PUP ETH-P-PUPAT ETH-P-IP ETH-P-X25 ETH-P-ARP \
630 ETH-P-BPQ ETH-P-IEEEPUP ETH-P-IEEEPUPAT ETH-P-DEC ETH-P-DNA-DL \
631 ETH-P-DNA-RC ETH-P-DNA-RT ETH-P-LAT ETH-P-DIAG ETH-P-CUST \
632 ETH-P-SCA ETH-P-RARP ETH-P-ATALK ETH-P-AARP ETH-P-IPX ETH-P-IPV6 \
633 ETH-P-PPP-DISC ETH-P-PPP-SES ETH-P-ATMMPOA ETH-P-ATMFATE \
634 ETH-P-802-3 ETH-P-AX25 ETH-P-ALL ETH-P-802-2 ETH-P-SNAP \
635 ETH-P-DDCMP ETH-P-WAN-PPP ETH-P-PPP-MP ETH-P-LOCALTALK \
636 ETH-P-PPPTALK ETH-P-TR-802-2 ETH-P-MOBITEX ETH-P-CONTROL \
637 ETH-P-IRDA ETH-P-ECONET)
638
639 /* check the protocol - number, string, or constant from check_socket_protocol
640 can trigger GC */
get_socket_protocol(object proto)641 static int get_socket_protocol (object proto) {
642 #if defined(HAVE_GETPROTOBYNAME)
643 get_socket_protocol_restart:
644 if (stringp(proto)) {
645 struct protoent *pe;
646 with_string_0(proto,GLO(misc_encoding),protoz, {
647 begin_system_call(); pe = getprotobyname(protoz); end_system_call();
648 });
649 if (pe) return pe->p_proto;
650 pushSTACK(NIL); /* no PLACE */
651 pushSTACK(proto); pushSTACK(TheSubr(subr_self)->name);
652 check_value(error_condition,GETTEXT("~S: invalid protocol name ~S"));
653 proto = value1;
654 goto get_socket_protocol_restart;
655 } else
656 #endif
657 return check_socket_protocol(proto);
658 }
659
660 DEFUN(RAWSOCK:SOCKET,domain type protocol) {
661 rawsock_t sock;
662 int protocol = get_socket_protocol(popSTACK());
663 int type = check_socket_type(popSTACK());
664 int domain = check_socket_domain(popSTACK());
665 SYSCALL(sock,-1,socket(domain,type,protocol));
666 VALUES1(fixnum(sock));
667 }
668
669 DEFUN(RAWSOCK:SOCKETPAIR,domain type protocol) {
670 rawsock_t sock[2];
671 int retval;
672 int protocol = get_socket_protocol(popSTACK());
673 int type = check_socket_type(popSTACK());
674 int domain = check_socket_domain(popSTACK());
675 #if defined(HAVE_SOCKETPAIR)
676 SYSCALL(retval,-1,socketpair(domain,type,protocol,sock));
677 #else /* woe32 et al */
678 struct sockaddr_in addr;
679 socklen_t sa_size = sizeof(struct sockaddr_in);
680 rawsock_t newsock;
681 addr.sin_family = domain;
682 addr.sin_port = 0; /* OS will assign an available port */
683 addr.sin_addr.s_addr = 16777343; /* 127.0.0.1 */
684 SYSCALL(sock[0],-1,socket(domain,type,protocol));
685 SYSCALL(sock[1],-1,socket(domain,type,protocol));
686 SYSCALL(retval,sock[1],bind(sock[1],(struct sockaddr*)&addr,
687 sizeof(struct sockaddr_in)));
688 SYSCALL(retval,sock[1],listen(sock[1],1));
689 /* figure out what port was assigned: */
690 SYSCALL(retval,sock[1],getsockname(sock[1],(struct sockaddr*)&addr,&sa_size));
691 SYSCALL(retval,sock[0],connect(sock[0],(struct sockaddr*)&addr,sa_size));
692 SYSCALL(newsock,sock[1],accept(sock[1],(struct sockaddr*)&addr,&sa_size));
693 /* do not need the server anymore: */
694 SYSCALL(retval,sock[1],close(sock[1]));
695 sock[1] = newsock;
696 #endif
697 VALUES2(fixnum(sock[0]),fixnum(sock[1]));
698 }
699
700 #if defined(HAVE_SOCKATMARK)
701 DEFUN(RAWSOCK:SOCKATMARK, sock) {
702 rawsock_t sock = I_to_uint(check_uint(popSTACK()));
703 int retval;
704 SYSCALL(retval,sock,sockatmark(sock));
705 VALUES_IF(retval);
706 }
707 #endif
708
709 /* process optional (struct sockaddr*) argument:
710 NIL: return NULL
711 T: allocate
712 SOCKADDR: extract data
713 the return value is invalidated by GC, only use in with_opt_sa_arg
714 can trigger GC */
optional_sockaddr_argument(gcv_object_t * arg,socklen_t * size PIN_ARG_DECL)715 static /*maygc*/ struct sockaddr* optional_sockaddr_argument
716 (gcv_object_t *arg, socklen_t *size PIN_ARG_DECL) {
717 if (nullp(*arg)) return NULL;
718 else {
719 if (eq(T,*arg)) *arg = make_sockaddr();
720 { struct sockaddr* sa =
721 (struct sockaddr*)check_struct_data(`RAWSOCK::SOCKADDR`,
722 arg,size,PROT_READ_WRITE);
723 pin_varobject_with_pc(pcv,*arg);
724 return sa;
725 }
726 }
727 }
728 #if defined(MULTITHREAD)
729 #define with_opt_sa_arg(_sa,_arg_,_size,_code) do { \
730 pinned_chain_t pc; \
731 struct sockaddr *sa = optional_sockaddr_argument(_arg_,_size,&pc); \
732 _code; \
733 if (sa) unpin_varobject(pc.pc_varobject); \
734 } while(0)
735 #else
736 #define with_opt_sa_arg(_sa,_arg_,_size,_code) do { \
737 struct sockaddr *sa = optional_sockaddr_argument(_arg_,_size); \
738 _code; \
739 } while(0)
740 #endif
741
742 DEFUN(RAWSOCK:ACCEPT,socket sockaddr) {
743 rawsock_t sock = I_to_uint(check_uint(STACK_1));
744 int retval;
745 socklen_t sa_size;
746 with_opt_sa_arg(sa,&STACK_0,&sa_size,
747 SYSCALL(retval,sock,accept(sock,sa,&sa_size)));
748 VALUES3(fixnum(retval),fixnum(sa_size),STACK_0); skipSTACK(2);
749 }
750
751 DEFUN(RAWSOCK:BIND,socket sockaddr) {
752 rawsock_t sock = I_to_uint(check_uint(STACK_1));
753 int retval;
754 socklen_t size;
755 with_sockaddr_arg(sa,&STACK_0,&size,PROT_READ,
756 SYSCALL(retval,sock,bind(sock,sa,size)));
757 VALUES0; skipSTACK(2);
758 }
759
760 DEFUN(RAWSOCK:CONNECT,socket sockaddr) {
761 rawsock_t sock = I_to_uint(check_uint(STACK_1));
762 int retval;
763 socklen_t size;
764 with_sockaddr_arg(sa,&STACK_0,&size,PROT_READ,
765 SYSCALL(retval,sock,connect(sock,sa,size)));
766 VALUES0; skipSTACK(2);
767 }
768
769 DEFUN(RAWSOCK:GETPEERNAME,socket sockaddr) {
770 rawsock_t sock = I_to_uint(check_uint(STACK_1));
771 int retval;
772 socklen_t sa_size;
773 with_opt_sa_arg(sa,&STACK_0,&sa_size,
774 SYSCALL(retval,sock,getpeername(sock,sa,&sa_size)));
775 VALUES2(STACK_0,fixnum(sa_size)); skipSTACK(2);
776 }
777
778 DEFUN(RAWSOCK:GETSOCKNAME,socket sockaddr) {
779 rawsock_t sock = I_to_uint(check_uint(STACK_1));
780 int retval;
781 socklen_t sa_size;
782 with_opt_sa_arg(sa,&STACK_0,&sa_size,
783 SYSCALL(retval,sock,getsockname(sock,sa,&sa_size)));
784 VALUES2(STACK_0,fixnum(sa_size)); skipSTACK(2);
785 }
786
787 DEFUN(RAWSOCK:SOCK-LISTEN,socket &optional backlog) {
788 int backlog = check_uint_defaulted(popSTACK(),SOMAXCONN);
789 rawsock_t sock = I_to_uint(check_uint(popSTACK()));
790 int retval;
791 SYSCALL(retval,sock,listen(sock,backlog));
792 VALUES0;
793 }
794
795 #if defined(WIN32_NATIVE)
error_missing(object function)796 static _Noreturn void error_missing (object function) {
797 pushSTACK(function); pushSTACK(TheSubr(subr_self)->name);
798 error(error_condition,GETTEXT("~S: your ws2_32.dll does not implement ~S"));
799 }
800 #endif
801
802 #if defined(HAVE_GAI_STRERROR) || defined(WIN32_NATIVE)
803 #if defined(WIN32_NATIVE)
804 typedef char* (WSAAPI *gai_strerror_t) (int);
my_gai_strerror(int ecode)805 static char* WSAAPI my_gai_strerror (int ecode)
806 { error_missing(`"gai_strerror"`); }
807 static gai_strerror_t gai_strerror_f = &my_gai_strerror;
808 #else
809 # define gai_strerror_f gai_strerror
810 #endif
811 DEFCHECKER(check_gai_ecode,prefix=EAI,default=,AGAIN BADFLAGS FAIL FAMILY \
812 MEMORY NONAME OVERFLOW SERVICE SOCKTYPE SYSTEM NODATA ADDRFAMILY \
813 INPROGRESS CANCELED NOTCANCELED INTR IDN_ENCODE)
814 #else
815 # define check_gai_ecode_reverse L_to_I
816 #endif
error_eai(int ecode)817 static _Noreturn void error_eai (int ecode) {
818 begin_system_call();
819 {
820 #if defined(HAVE_GAI_STRERROR) || defined(WIN32_NATIVE)
821 const char* msg = gai_strerror_f(ecode);
822 #else
823 const char* msg = strerror(ecode);
824 #endif
825 end_system_call();
826 pushSTACK(`RAWSOCK::EAI`); /* error type */
827 pushSTACK(S(Kcode)); pushSTACK(check_gai_ecode_reverse(ecode));
828 pushSTACK(`:MESSAGE`); pushSTACK(safe_to_string(msg));
829 funcall(S(make_instance),5);
830 pushSTACK(value1); funcall(S(error),1);
831 NOTREACHED;
832 }
833 }
834
835 #if defined(HAVE_GETNAMEINFO) || defined(WIN32_NATIVE)
836 #if defined(WIN32_NATIVE)
837 typedef int (WSAAPI *getnameinfo_t) (const struct sockaddr*,socklen_t,char*,
838 DWORD,char*,DWORD,int);
my_getnameinfo(const struct sockaddr * sa,socklen_t sl,char * nd,DWORD ndl,char * sv,DWORD svl,int f)839 static int WSAAPI my_getnameinfo (const struct sockaddr* sa,socklen_t sl,
840 char* nd,DWORD ndl,char* sv,DWORD svl,int f)
841 { error_missing(`"getnameinfo"`); }
842 static getnameinfo_t getnameinfo_f = &my_getnameinfo;
843 #else
844 # define getnameinfo_f getnameinfo
845 #endif
DEFFLAGSET(getnameinfo_flags,NI_NOFQDN NI_NUMERICHOST NI_NAMEREQD NI_NUMERICSERV NI_NUMERICSCOPE NI_DGRAM)846 DEFFLAGSET(getnameinfo_flags, NI_NOFQDN NI_NUMERICHOST NI_NAMEREQD \
847 NI_NUMERICSERV NI_NUMERICSCOPE NI_DGRAM)
848 DEFUN(RAWSOCK:GETNAMEINFO, sockaddr &key NOFQDN NUMERICHOST NAMEREQD \
849 NUMERICSERV NUMERICSCOPE DGRAM) {
850 int flags = getnameinfo_flags();
851 socklen_t size;
852 char node[BUFSIZ], service[BUFSIZ];
853 int status;
854 with_sockaddr_arg(sa,&STACK_0,&size,PROT_READ, {
855 begin_sock_call();
856 status = getnameinfo_f(sa,size,node,BUFSIZ,service,BUFSIZ,flags);
857 end_sock_call();
858 });
859 if (status) error_eai(status);
860 STACK_0 = asciz_to_string(service,GLO(misc_encoding));
861 VALUES2(asciz_to_string(node,GLO(misc_encoding)),popSTACK());
862 }
863 #endif
864 #if (defined(HAVE_GETADDRINFO) && defined(HAVE_FREEADDRINFO)) || defined(WIN32_NATIVE)
865 #if defined(WIN32_NATIVE)
866 typedef void (WSAAPI *freeaddrinfo_t) (struct addrinfo*);
my_freeaddrinfo(struct addrinfo * ai)867 static void WSAAPI my_freeaddrinfo (struct addrinfo* ai)
868 { error_missing(`"freeaddrinfo"`); }
869 typedef int (WSAAPI *getaddrinfo_t)
870 (const char*,const char*, const struct addrinfo*, struct addrinfo**);
871 static freeaddrinfo_t freeaddrinfo_f = &my_freeaddrinfo;
my_getaddrinfo(const char * nd,const char * sv,const struct addrinfo * hints,struct addrinfo ** ret)872 static int WSAAPI my_getaddrinfo (const char* nd,const char* sv,
873 const struct addrinfo* hints,
874 struct addrinfo** ret)
875 { error_missing(`"getaddrinfo"`); }
876 static getaddrinfo_t getaddrinfo_f = &my_getaddrinfo;
877 #else
878 # define getaddrinfo_f getaddrinfo
879 # define freeaddrinfo_f freeaddrinfo
880 #endif
DEFFLAGSET(addrinfo_flags,AI_PASSIVE AI_CANONNAME AI_NUMERICHOST AI_NUMERICSERV AI_V4MAPPED AI_ALL AI_ADDRCONFIG)881 DEFFLAGSET(addrinfo_flags,AI_PASSIVE AI_CANONNAME AI_NUMERICHOST \
882 AI_NUMERICSERV AI_V4MAPPED AI_ALL AI_ADDRCONFIG)
883 DEFCHECKER(check_addrinfo_flags,prefix=AI,default=0,bitmasks=both, \
884 PASSIVE CANONNAME NUMERICHOST NUMERICSERV V4MAPPED :ALL ADDRCONFIG)
885 static void call_getaddrinfo (const char* nd,const char* sv,
886 const struct addrinfo* hints,
887 struct addrinfo** ret) {
888 int status;
889 begin_system_call();
890 if ((status = getaddrinfo_f(nd,sv,hints,ret))) error_eai(status);
891 end_system_call();
892 }
893 DEFUN(RAWSOCK:GETADDRINFO, &key NODE SERVICE PROTOCOL SOCKTYPE FAMILY \
894 PASSIVE CANONNAME NUMERICHOST NUMERICSERV V4MAPPED :ALL ADDRCONFIG) {
895 struct addrinfo hints;
896 struct addrinfo *ret = NULL, *tmp;
897 begin_system_call();
898 memset(&hints,0,sizeof(hints));
899 end_system_call();
900 hints.ai_flags = addrinfo_flags();
901 hints.ai_family = check_socket_domain(popSTACK());
902 hints.ai_socktype = check_socket_type(popSTACK());
903 hints.ai_protocol = get_socket_protocol(popSTACK());
904 int valcount = 0;
905 if (missingp(STACK_0)) {
906 if (missingp(STACK_1))
907 call_getaddrinfo(NULL,NULL,&hints,&ret);
908 else
909 with_string_0(check_string(STACK_1),GLO(misc_encoding),node, {
910 call_getaddrinfo(node,NULL,&hints,&ret);
911 });
912 } else {
913 with_string_0(check_string(STACK_0),GLO(misc_encoding),service, {
914 if (missingp(STACK_1))
915 call_getaddrinfo(NULL,service,&hints,&ret);
916 else
917 with_string_0(check_string(STACK_1),GLO(misc_encoding),node, {
918 call_getaddrinfo(node,service,&hints,&ret);
919 });
920 });
921 }
922 for (tmp = ret; tmp; tmp = tmp->ai_next, valcount++) {
923 pushSTACK(check_addrinfo_flags_to_list(tmp->ai_flags));
924 pushSTACK(check_socket_domain_reverse(tmp->ai_family));
925 pushSTACK(check_socket_type_reverse(tmp->ai_socktype));
926 pushSTACK(check_socket_protocol_reverse(tmp->ai_protocol));
927 pushSTACK(sockaddr_to_lisp(tmp->ai_addr,tmp->ai_addrlen));
928 pushSTACK(safe_to_string(tmp->ai_canonname));
929 funcall(`RAWSOCK::MAKE-ADDRINFO`,6); pushSTACK(value1);
930 }
931 if (ret) { begin_system_call(); freeaddrinfo_f(ret); end_system_call(); }
932 VALUES1(listof(valcount)); skipSTACK(2);
933 }
934 #endif
935
936 /* ================== RECEIVING ================== */
937 /* FIXME: replace this with a complete autoconf check using CL_PROTO() */
938 #if defined(WIN32_NATIVE)
939 # define BUF_TYPE_T char*
940 #else
941 # define BUF_TYPE_T void*
942 #endif
943
944 /* remove 3 objects from the STACK and return the RECV flag
945 based on MSG_PEEK MSG_OOB MSG_WAITALL */
DEFFLAGSET(recv_flags,MSG_PEEK MSG_OOB MSG_WAITALL)946 DEFFLAGSET(recv_flags,MSG_PEEK MSG_OOB MSG_WAITALL)
947 DEFUN(RAWSOCK:RECV,socket buffer &key :START :END PEEK OOB WAITALL) {
948 int flags = recv_flags();
949 rawsock_t sock = I_to_uint(check_uint(STACK_3));
950 int retval;
951 size_t buffer_len;
952 with_buffer_arg(buffer,&STACK_2,&buffer_len,PROT_READ_WRITE,
953 SYSCALL(retval,sock,recv(sock,(BUF_TYPE_T)buffer,
954 buffer_len,flags)));
955 VALUES1(fixnum(retval)); skipSTACK(2);
956 }
957
958 DEFUN(RAWSOCK:RECVFROM,socket buffer address &key :START :END PEEK OOB WAITALL){
959 int flags = recv_flags();
960 rawsock_t sock = I_to_uint(check_uint(STACK_4));
961 int retval;
962 void *buffer;
963 size_t buffer_len;
964 socklen_t sa_size;
965 if (!missingp(STACK_0)) STACK_0 = check_posfixnum(STACK_0);
966 if (!missingp(STACK_1)) STACK_1 = check_posfixnum(STACK_1);
967 STACK_3 = check_byte_vector(STACK_3);
968 with_opt_sa_arg(sa,&STACK_2,&sa_size,
969 with_buffer_arg(buffer,&STACK_3,&buffer_len,PROT_READ_WRITE,
970 SYSCALL(retval,sock,recvfrom(sock,(BUF_TYPE_T)buffer,
971 buffer_len,flags,sa,&sa_size))));
972 VALUES3(fixnum(retval),fixnum(sa_size),STACK_0); skipSTACK(3);
973 }
974
975 #if defined(HAVE_RECVMSG) && defined(HAVE_SENDMSG) && defined(HAVE_STRUCT_MSGHDR_MSG_FLAGS) && defined(HAVE_STRUCT_MSGHDR_MSG_CONTROL)
976 DEFCHECKER(check_msg_flags,prefix=MSG,bitmasks=both,default=0, \
977 OOB PEEK DONTROUTE TRYHARD CTRUNC PROXY TRUNC DONTWAIT EOR \
978 WAITALL FIN SYN CONFIRM RST ERRQUEUE NOSIGNAL MORE)
979 /* keep this in sync with sock.lisp */
980 #define MSG_SOCKADDR 1
981 #define MSG_IOVEC 2
982 #define MSG_CONTROL 3
983 #define MSG_FLAGS 4
984 /* check message structure, return size/offset for iovec & flags
985 < STACK_0, STACK_1: START & END, passed to check_iovec_arg() & removed
986 < mho -- MESSAGE structure object
987 > mho -- same, checked
988 > offset -- offset into the iovec
989 > mhp -- filled msg_iovlen, msg_flags
990 removes 2 elements from STACK
991 can trigger GC */
check_message(gcv_object_t * mho,uintL * offset,struct msghdr * mhp)992 static void check_message (gcv_object_t *mho, uintL *offset, struct msghdr *mhp)
993 {
994 *mho = check_classname(*mho,`RAWSOCK::MESSAGE`);
995 TheStructure(*mho)->recdata[MSG_SOCKADDR] =
996 check_classname(TheStructure(*mho)->recdata[MSG_SOCKADDR],
997 `RAWSOCK::SOCKADDR`);
998 mhp->msg_iovlen =
999 check_iovec_arg(&(TheStructure(*mho)->recdata[MSG_IOVEC]),offset);
1000 TheStructure(*mho)->recdata[MSG_CONTROL] =
1001 check_byte_vector(TheStructure(*mho)->recdata[MSG_CONTROL]);
1002 mhp->msg_flags =
1003 check_msg_flags_of_list(TheStructure(*mho)->recdata[MSG_FLAGS]);
1004 }
1005 /* fill msg_controllen, msg_control, msg_iov, msg_name from mho */
fill_msghdr(gcv_object_t * mho,uintL offset,struct msghdr * mhp,int prot PIN_ARG_DECL)1006 static void fill_msghdr (gcv_object_t *mho, uintL offset, struct msghdr *mhp,
1007 int prot PIN_ARG_DECL) {
1008 mhp->msg_controllen =
1009 vector_length(TheStructure(*mho)->recdata[MSG_CONTROL]);
1010 mhp->msg_control =
1011 TheSbvector(TheStructure(*mho)->recdata[MSG_CONTROL])->data;
1012 handle_fault_range(prot,(aint)mhp->msg_control,
1013 (aint)mhp->msg_control + mhp->msg_controllen);
1014 fill_iovec(TheStructure(*mho)->recdata[MSG_IOVEC],offset,mhp->msg_iovlen,
1015 mhp->msg_iov,prot PIN_ARG_USE);
1016 pushSTACK(TheStructure(*mho)->recdata[MSG_SOCKADDR]);
1017 mhp->msg_name = (struct sockaddr*)
1018 check_struct_data(`RAWSOCK::SOCKADDR`,&STACK_0,&(mhp->msg_namelen),prot);
1019 pin_varobject_with_pc(&(pcv[mhp->msg_iovlen]),STACK_0);
1020 TheStructure(*mho)->recdata[MSG_SOCKADDR] = popSTACK();
1021 }
1022 /* POSIX recvmsg() */
1023 DEFUN(RAWSOCK:RECVMSG,socket message &key :START :END PEEK OOB WAITALL) {
1024 int flags = recv_flags();
1025 rawsock_t sock = I_to_uint(check_uint(STACK_3));
1026 int retval;
1027 struct msghdr message;
1028 uintL offset;
1029 PIN_DECL;
1030 check_message(&STACK_2,&offset,&message);
1031 message.msg_iov =
1032 (struct iovec*)alloca(message.msg_iovlen * sizeof(struct iovec));
1033 PIN_INIT(message.msg_iovlen+1);
1034 fill_msghdr(&STACK_0,offset,&message,PROT_READ_WRITE PIN_ARG_USE);
1035 SYSCALL(retval,sock,recvmsg(sock,&message,flags));
1036 unpin_varobjects(message.msg_iovlen+1);
1037 TheStructure(STACK_0)->recdata[MSG_FLAGS] =
1038 check_msg_flags_to_list(message.msg_flags);
1039 VALUES2(fixnum(retval),fixnum(message.msg_namelen)); skipSTACK(2);
1040 }
1041 #endif /* HAVE_RECVMSG & HAVE_MSGHDR_MSG_FLAGS & HAVE_MSGHDR_MSG_CONTROL */
1042
1043 DEFUN(RAWSOCK:SOCK-READ,socket buffer &key :START :END)
1044 { /* http://www.opengroup.org/onlinepubs/9699919799/functions/read.html
1045 http://www.opengroup.org/onlinepubs/9699919799/functions/readv.html */
1046 rawsock_t sock = I_to_uint(check_uint(STACK_3));
1047 ssize_t retval;
1048 size_t len;
1049 uintL offset;
1050 if ((retval = check_iovec_arg(&STACK_2,&offset)) >= 0) { /* READV */
1051 ssize_t pinned_count = retval;
1052 struct iovec *buffer = (struct iovec*)alloca(sizeof(struct iovec)*retval);
1053 PIN_DECL; PIN_INIT(pinned_count);
1054 fill_iovec(STACK_0,offset,retval,buffer,PROT_READ_WRITE PIN_ARG_USE);
1055 SYSCALL(retval,sock,readv(sock,buffer,retval));
1056 unpin_varobjects(pinned_count);
1057 } else /* READ */
1058 with_buffer_arg(buffer,&STACK_2,&len,PROT_READ_WRITE,
1059 SYSCALL(retval,sock,READ(sock,buffer,len)));
1060 VALUES1(ssize_to_I(retval)); skipSTACK(2);
1061 }
1062
1063 /* ================== SENDING ================== */
1064
1065 /* remove 2 objects from the STACK and return the SEND flag
1066 based on MSG_OOB MSG_EOR */
DEFFLAGSET(send_flags,MSG_OOB MSG_EOR)1067 DEFFLAGSET(send_flags, MSG_OOB MSG_EOR)
1068 DEFUN(RAWSOCK:SEND,socket buffer &key :START :END OOB EOR) {
1069 int flags = send_flags();
1070 rawsock_t sock = I_to_uint(check_uint(STACK_3));
1071 int retval;
1072 size_t buffer_len;
1073 with_buffer_arg(buffer,&STACK_2,&buffer_len,PROT_READ,
1074 SYSCALL(retval,sock,send(sock,(const BUF_TYPE_T)buffer,
1075 buffer_len,flags)));
1076 VALUES1(fixnum(retval)); skipSTACK(2);
1077 }
1078
1079 #if defined(HAVE_RECVMSG) && defined(HAVE_SENDMSG) && defined(HAVE_STRUCT_MSGHDR_MSG_FLAGS) && defined(HAVE_STRUCT_MSGHDR_MSG_CONTROL)
1080 /* POSIX sendmsg() */
1081 DEFUN(RAWSOCK:SENDMSG,socket message &key :START :END OOB EOR) {
1082 int flags = send_flags();
1083 rawsock_t sock = I_to_uint(check_uint(STACK_3));
1084 int retval;
1085 struct msghdr message;
1086 uintL offset;
1087 PIN_DECL;
1088 check_message(&STACK_2,&offset,&message);
1089 message.msg_iov =
1090 (struct iovec*)alloca(message.msg_iovlen * sizeof(struct iovec));
1091 PIN_INIT(message.msg_iovlen+1);
1092 fill_msghdr(&STACK_0,offset,&message,PROT_READ PIN_ARG_USE);
1093 SYSCALL(retval,sock,sendmsg(sock,&message,flags));
1094 unpin_varobjects(message.msg_iovlen+1);
1095 TheStructure(STACK_0)->recdata[MSG_FLAGS] =
1096 check_msg_flags_to_list(message.msg_flags);
1097 VALUES1(fixnum(retval)); skipSTACK(2);
1098 }
1099 #endif /* HAVE_SENDMSG & HAVE_MSGHDR_MSG_FLAGS & HAVE_MSGHDR_MSG_CONTROL */
1100
1101 DEFUN(RAWSOCK:SENDTO, socket buffer address &key :START :END OOB EOR) {
1102 int flags = send_flags();
1103 rawsock_t sock = I_to_uint(check_uint(STACK_4));
1104 int retval;
1105 size_t buffer_len;
1106 socklen_t size;
1107 if (!missingp(STACK_0)) STACK_0 = check_posfixnum(STACK_0);
1108 if (!missingp(STACK_1)) STACK_1 = check_posfixnum(STACK_1);
1109 STACK_3 = check_byte_vector(STACK_3);
1110 with_sockaddr_arg(sa,&STACK_2,&size,PROT_READ,
1111 with_buffer_arg(buffer,&STACK_3,&buffer_len,PROT_READ,
1112 SYSCALL(retval,sock,sendto(sock,(const BUF_TYPE_T)buffer,
1113 buffer_len,flags,sa,size))));
1114 VALUES1(fixnum(retval)); skipSTACK(3);
1115 }
1116
1117 DEFUN(RAWSOCK:SOCK-WRITE,socket buffer &key :START :END)
1118 { /* http://www.opengroup.org/onlinepubs/9699919799/functions/write.html
1119 http://www.opengroup.org/onlinepubs/9699919799/functions/writev.html */
1120 rawsock_t sock = I_to_uint(check_uint(STACK_3));
1121 ssize_t retval;
1122 size_t len;
1123 uintL offset;
1124 if ((retval = check_iovec_arg(&STACK_2,&offset)) >= 0) { /* WRITEV */
1125 ssize_t pinned_count = retval;
1126 struct iovec *buffer = (struct iovec*)alloca(sizeof(struct iovec)*retval);
1127 PIN_DECL; PIN_INIT(pinned_count);
1128 fill_iovec(STACK_0,offset,retval,buffer,PROT_READ PIN_ARG_USE);
1129 SYSCALL(retval,sock,writev(sock,buffer,retval));
1130 unpin_varobjects(pinned_count);
1131 } else /* WRITE */
1132 with_buffer_arg(buffer,&STACK_2,&len,PROT_READ,
1133 SYSCALL(retval,sock,WRITE(sock,buffer,len)));
1134 VALUES1(ssize_to_I(retval)); skipSTACK(2);
1135 }
1136
1137 DEFUN(RAWSOCK:SOCK-CLOSE, socket) {
1138 rawsock_t sock = I_to_uint(check_uint(popSTACK()));
1139 int retval;
1140 SYSCALL(retval,sock,close(sock));
1141 VALUES1(fixnum(retval));
1142 }
1143
1144 #if defined(HAVE_NET_IF_H)
1145 /* STACK_1 = ifname, for error reporting */
configdev(rawsock_t sock,char * ifname,int ipaddress,int flags)1146 static void configdev (rawsock_t sock, char* ifname, int ipaddress, int flags) {
1147 struct ifreq ifrequest;
1148 #if defined(SIOCGIFFLAGS) && defined(SIOCSIFFLAGS)
1149 memset(&ifrequest, 0, sizeof(struct ifreq));
1150 strncpy(ifrequest.ifr_name, ifname, IFNAMSIZ);
1151 if (ioctl(sock, SIOCGIFFLAGS, &ifrequest) < 0)
1152 OS_file_error(STACK_1);
1153 ifrequest.ifr_flags |= flags;
1154 if (ioctl(sock, SIOCSIFFLAGS, &ifrequest) < 0)
1155 OS_file_error(STACK_1);
1156 #endif
1157 #if defined(SIOCGIFADDR) && defined(SIOCSIFADDR)
1158 memset(&ifrequest, 0, sizeof(struct ifreq));
1159 strncpy(ifrequest.ifr_name, ifname, IFNAMSIZ);
1160 if (ioctl(sock, SIOCGIFADDR, &ifrequest) < 0)
1161 OS_file_error(STACK_1);
1162 /* address was 0.0.0.0 -> error */
1163 if (ipaddress != 0) {
1164 if (ioctl(sock, SIOCGIFADDR, &ifrequest) < 0)
1165 OS_file_error(STACK_1);
1166 else {
1167 register int j;
1168 for (j=2;j<6;j++) ifrequest.ifr_addr.sa_data[j] = 0;
1169 if (ioctl(sock, SIOCSIFADDR, &ifrequest) < 0)
1170 OS_file_error(STACK_1);
1171 }
1172 }
1173 #endif
1174 }
1175
DEFFLAGSET(configdev_flags,IFF_PROMISC IFF_NOARP)1176 DEFFLAGSET(configdev_flags,IFF_PROMISC IFF_NOARP)
1177 DEFUN(RAWSOCK:CONFIGDEV, socket ifname ipaddress &key PROMISC NOARP) {
1178 int flags = configdev_flags();
1179 uint32 ipaddress = I_to_UL(check_uint32(STACK_0));
1180 rawsock_t sock = I_to_uint(check_uint(STACK_2));
1181 with_string_0(check_string(STACK_1),Symbol_value(S(utf_8)),ifname, {
1182 begin_blocking_system_call();
1183 configdev(sock, ifname, ipaddress, flags);
1184 end_blocking_system_call();
1185 });
1186 VALUES0; skipSTACK(3);
1187 }
1188 #endif /* HAVE_NET_IF_H */
1189
1190 /* ================== socket options ================== */
1191 #if defined(HAVE_GETSOCKOPT) || defined(HAVE_SETSOCKOPT) || defined(WIN32_NATIVE)
1192 DEFCHECKER(sockopt_level,default=SOL_SOCKET, :ALL=-1 SOL-SOCKET \
1193 SOL-IP SOL-IPX SOL-AX25 SOL-ATALK SOL-NETROM SOL-TCP SOL-UDP \
1194 IPPROTO-IP IPPROTO-IPV6 IPPROTO-ICMP IPPROTO-RAW IPPROTO-TCP \
1195 IPPROTO-UDP IPPROTO-IGMP IPPROTO-IPIP IPPROTO-EGP IPPROTO-PUP \
1196 IPPROTO-IDP IPPROTO-GGP IPPROTO-ND IPPROTO-HOPOPTS \
1197 IPPROTO-ROUTING IPPROTO-FRAGMENT IPPROTO-ESP IPPROTO-AH \
1198 IPPROTO-ICMPV6 IPPROTO-DSTOPTS IPPROTO-NONE)
1199 DEFCHECKER(sockopt_name,default=-1,prefix=SO, \
1200 DEBUG ACCEPTCONN BROADCAST USELOOPBACK PEERCRED \
1201 REUSEADDR KEEPALIVE LINGER OOBINLINE SNDBUF RCVBUF :ERROR :TYPE \
1202 DONTROUTE RCVLOWAT RCVTIMEO SNDLOWAT SNDTIMEO)
1203 #endif
1204 #if defined(HAVE_GETSOCKOPT) || defined(WIN32_NATIVE)
1205 #define GET_SOCK_OPT(opt_type,retform) do { \
1206 opt_type val; \
1207 socklen_t len = sizeof(val); \
1208 int status; \
1209 begin_sock_call(); \
1210 status = getsockopt(sock,level,name,(SETSOCKOPT_ARG_T)&val,&len); \
1211 end_sock_call(); \
1212 if (status==0) return retform; \
1213 else return (err_p ? OS_file_error(fixnum(sock)),NIL : S(Kerror)); \
1214 } while(0)
check_sockopt_name(int name)1215 static int check_sockopt_name (int name) {
1216 pushSTACK(NIL); /* no PLACE */
1217 pushSTACK(fixnum(name));
1218 pushSTACK(TheSubr(subr_self)->name);
1219 check_value(error_condition,GETTEXT("~S: invalid option ~S"));
1220 return sockopt_name(value1);
1221 }
1222 /* can trigger GC */
get_sock_opt(rawsock_t sock,int level,int name,int err_p)1223 static object get_sock_opt (rawsock_t sock, int level, int name, int err_p) {
1224 get_sock_opt_restart:
1225 switch (name) {
1226 # if defined(SO_DEBUG)
1227 case SO_DEBUG:
1228 # endif
1229 # if defined(SO_ACCEPTCONN)
1230 case SO_ACCEPTCONN:
1231 # endif
1232 # if defined(SO_BROADCAST)
1233 case SO_BROADCAST:
1234 # endif
1235 # if defined(SO_REUSEADDR)
1236 case SO_REUSEADDR:
1237 # endif
1238 # if defined(SO_KEEPALIVE)
1239 case SO_KEEPALIVE:
1240 # endif
1241 # if defined(SO_OOBINLINE)
1242 case SO_OOBINLINE:
1243 # endif
1244 # if defined(SO_DONTROUTE)
1245 case SO_DONTROUTE:
1246 # endif
1247 # if defined(SO_USELOOPBACK)
1248 case SO_USELOOPBACK:
1249 # endif
1250 GET_SOCK_OPT(int,val ? T : NIL);
1251 # if defined(SO_PEERCRED)
1252 case SO_PEERCRED:
1253 # endif
1254 # if defined(SO_RCVLOWAT)
1255 case SO_RCVLOWAT:
1256 # endif
1257 # if defined(SO_SNDLOWAT)
1258 case SO_SNDLOWAT:
1259 # endif
1260 # if defined(SO_SNDBUF)
1261 case SO_SNDBUF:
1262 # endif
1263 # if defined(SO_RCVBUF)
1264 case SO_RCVBUF:
1265 # endif
1266 # if defined(SO_ERROR)
1267 case SO_ERROR:
1268 # endif
1269 GET_SOCK_OPT(int,sint_to_I(val));
1270 # if defined(SO_TYPE)
1271 case SO_TYPE:
1272 GET_SOCK_OPT(int,check_socket_type_reverse(val));
1273 # endif
1274 # if defined(SO_LINGER)
1275 case SO_LINGER:
1276 GET_SOCK_OPT(struct linger,val.l_onoff ? sint_to_I(val.l_linger) : NIL);
1277 # endif
1278 # if defined(SO_RCVTIMEO)
1279 case SO_RCVTIMEO:
1280 # endif
1281 # if defined(SO_SNDTIMEO)
1282 case SO_SNDTIMEO:
1283 # endif
1284 GET_SOCK_OPT(struct timeval,sec_usec_number(val.tv_sec,val.tv_usec,0));
1285 default: name = check_sockopt_name(name);
1286 goto get_sock_opt_restart;
1287 }
1288 }
1289 #undef GET_SOCK_OPT
1290 DEFUN(RAWSOCK:SOCKET-OPTION, sock name &key :LEVEL)
1291 { /* http://www.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html */
1292 int level = sockopt_level(popSTACK());
1293 int name = sockopt_name(popSTACK());
1294 rawsock_t sock;
1295 stream_handles(popSTACK(),true,NULL,&sock,NULL);
1296 if (level == -1) { /* :ALL */
1297 int pos1;
1298 for (pos1=1; pos1 < sockopt_level_map.size; pos1++) {
1299 const c_lisp_pair_t *level_clp = &(sockopt_level_map.table[pos1]);
1300 pushSTACK(*(level_clp->l_const));
1301 if (name == -1) {
1302 int pos2;
1303 for (pos2=0; pos2 < sockopt_name_map.size; pos2++) {
1304 const c_lisp_pair_t *name_clp = &(sockopt_name_map.table[pos2]);
1305 pushSTACK(*name_clp->l_const);
1306 pushSTACK(get_sock_opt(sock,level_clp->c_const,name_clp->c_const,0));
1307 }
1308 { object tmp = listof(2*sockopt_name_map.size); pushSTACK(tmp); }
1309 } else
1310 pushSTACK(get_sock_opt(sock,level_clp->c_const,name,0));
1311 }
1312 VALUES1(listof(2*(sockopt_level_map.size-1))); /* skip :ALL */
1313 } else {
1314 if (name == -1) {
1315 int pos2;
1316 for (pos2=0; pos2 < sockopt_name_map.size; pos2++) {
1317 const c_lisp_pair_t *name_clp = &(sockopt_name_map.table[pos2]);
1318 pushSTACK(*(name_clp->l_const));
1319 pushSTACK(get_sock_opt(sock,level,name_clp->c_const,0));
1320 }
1321 VALUES1(listof(2*sockopt_name_map.size));
1322 } else
1323 VALUES1(get_sock_opt(sock,level,name,1));
1324 }
1325 }
1326 #endif
1327 #if defined(HAVE_SETSOCKOPT) || defined(WIN32_NATIVE)
1328 #define SET_SOCK_OPT(opt_type,valform) do { \
1329 int status; \
1330 opt_type val; valform; \
1331 begin_sock_call(); \
1332 status = setsockopt(sock,level,name,(SETSOCKOPT_ARG_T)&val,sizeof(val)); \
1333 end_sock_call(); \
1334 if (status) OS_file_error(fixnum(sock)); \
1335 return; \
1336 } while(0)
set_sock_opt(rawsock_t sock,int level,int name,object value)1337 static void set_sock_opt (rawsock_t sock, int level, int name, object value) {
1338 if (eq(value,S(Kerror))) return;
1339 set_sock_opt_restart:
1340 switch (name) {
1341 # if defined(SO_DEBUG)
1342 case SO_DEBUG:
1343 # endif
1344 # if defined(SO_ACCEPTCONN)
1345 case SO_ACCEPTCONN:
1346 # endif
1347 # if defined(SO_BROADCAST)
1348 case SO_BROADCAST:
1349 # endif
1350 # if defined(SO_REUSEADDR)
1351 case SO_REUSEADDR:
1352 # endif
1353 # if defined(SO_KEEPALIVE)
1354 case SO_KEEPALIVE:
1355 # endif
1356 # if defined(SO_OOBINLINE)
1357 case SO_OOBINLINE:
1358 # endif
1359 # if defined(SO_DONTROUTE)
1360 case SO_DONTROUTE:
1361 # endif
1362 # if defined(SO_USELOOPBACK)
1363 case SO_USELOOPBACK:
1364 # endif
1365 SET_SOCK_OPT(int,val=!nullp(value));
1366 # if defined(SO_PEERCRED)
1367 case SO_PEERCRED:
1368 # endif
1369 # if defined(SO_RCVLOWAT)
1370 case SO_RCVLOWAT:
1371 # endif
1372 # if defined(SO_SNDLOWAT)
1373 case SO_SNDLOWAT:
1374 # endif
1375 # if defined(SO_SNDBUF)
1376 case SO_SNDBUF:
1377 # endif
1378 # if defined(SO_RCVBUF)
1379 case SO_RCVBUF:
1380 # endif
1381 # if defined(SO_ERROR)
1382 case SO_ERROR:
1383 # endif
1384 SET_SOCK_OPT(int,val=I_to_sint32(check_sint32(value)));
1385 # if defined(SO_TYPE)
1386 case SO_TYPE:
1387 SET_SOCK_OPT(int,val=check_socket_type(value));
1388 # endif
1389 # if defined(SO_LINGER)
1390 case SO_LINGER:
1391 SET_SOCK_OPT(struct linger,
1392 if (nullp(value)) val.l_onoff=0;
1393 else { val.l_onoff = 1;
1394 val.l_linger = I_to_sint32(check_sint32(value));});
1395 # endif
1396 # if defined(SO_RCVTIMEO)
1397 case SO_RCVTIMEO:
1398 # endif
1399 # if defined(SO_SNDTIMEO)
1400 case SO_SNDTIMEO:
1401 # endif
1402 SET_SOCK_OPT(struct timeval,sec_usec(value,NIL,&val));
1403 default: name = check_sockopt_name(name);
1404 goto set_sock_opt_restart;
1405 }
1406 }
1407 #undef SET_SOCK_OPT
1408 /* name=-1 => set many socket options from the plist
1409 otherwise => set this option
1410 can trigger GC */
set_sock_opt_many(rawsock_t sock,int level,int name,object opt_or_plist)1411 static void set_sock_opt_many (rawsock_t sock, int level, int name,
1412 object opt_or_plist) {
1413 if (name == -1) {
1414 pushSTACK(opt_or_plist); pushSTACK(opt_or_plist);
1415 while (!endp(STACK_0)) {
1416 int name = sockopt_name(Car(STACK_0));
1417 STACK_0 = Cdr(STACK_0);
1418 if (!consp(STACK_0)) error_plist_odd(STACK_1);
1419 set_sock_opt(sock,level,name,Car(STACK_0));
1420 STACK_0 = Cdr(STACK_0);
1421 }
1422 skipSTACK(2);
1423 } else
1424 set_sock_opt(sock,level,name,opt_or_plist);
1425 }
1426
1427 DEFUN(RAWSOCK::SET-SOCKET-OPTION, value sock name &key :LEVEL)
1428 { /* http://www.opengroup.org/onlinepubs/9699919799/functions/setsockopt.html */
1429 int level = sockopt_level(popSTACK());
1430 int name = sockopt_name(popSTACK());
1431 rawsock_t sock;
1432 stream_handles(popSTACK(),true,NULL,&sock,NULL);
1433 if (level == -1) { /* :ALL */
1434 pushSTACK(STACK_0);
1435 while (!endp(STACK_0)) {
1436 int level = sockopt_level(Car(STACK_0));
1437 STACK_0 = Cdr(STACK_0);
1438 if (!consp(STACK_0)) error_plist_odd(STACK_1);
1439 set_sock_opt_many(sock,level,name,Car(STACK_0));
1440 STACK_0 = Cdr(STACK_0);
1441 }
1442 skipSTACK(1);
1443 } else
1444 set_sock_opt_many(sock,level,name,STACK_0);
1445 VALUES1(popSTACK());
1446 }
1447 #endif
1448
1449 /* ================== CHECKSUM from Fred Cohen ================== */
1450 /* these check sum functions operate on ethernet _frames_, i.e.:
1451 - 6 bytes of the destination MAC address
1452 - 6 bytes of the source MAC address
1453 - 2 bytes specifying the next level protocol (e.g., 0800 for IP)
1454 followed by an IP datagram, so the first 14 bytes are ignored. */
ipcsum(unsigned char * buffer,size_t length)1455 static unsigned short ipcsum (unsigned char* buffer, size_t length) {
1456 register long sum=0; /* assumes long == 32 bits */
1457 unsigned short result;
1458 unsigned char *ptr=&(buffer[14]);
1459 unsigned int nbytes;
1460 ASSERT(length >= 26); /* FIXME: is this right?! */
1461 buffer[24]=0;buffer[25]=0;nbytes=(buffer[14] & 0xF) << 2; /* checksum=0, headerlen */
1462 while(nbytes>1){sum += *ptr; ptr++; sum += *ptr <<8; ptr++; nbytes -= 2;}
1463 if(nbytes==1){sum += *ptr;} /* mop up an odd byte, if necessary */
1464 sum = (sum >> 16) + (sum & 0xFFFF);
1465 result=~(sum + (sum >> 16)) & 0xFFFF;
1466 buffer[24]=(result & 0xFF);
1467 buffer[25]=((result >> 8) & 0xFF);
1468 return result;
1469 }
1470 DEFUN(RAWSOCK:IPCSUM, buffer &key :START :END) { /* IP checksum */
1471 size_t length;
1472 with_buffer_arg(buffer,&STACK_2,&length,PROT_READ_WRITE,
1473 length = ipcsum((unsigned char*)buffer,length));
1474 VALUES1(fixnum(length)); skipSTACK(1);
1475 }
1476
icmpcsum(unsigned char * buffer,size_t length)1477 static unsigned short icmpcsum (unsigned char* buffer, size_t length) {
1478 register long sum=0; /* assumes long == 32 bits */
1479 unsigned short result;
1480 unsigned char *ptr;
1481 unsigned int nbytes, off, offset;
1482 ASSERT(length >= 18); /* FIXME: is this right?! */
1483 off=((buffer[14]&0xF)<<2);offset=off+14; /* start of ICMP header */
1484 buffer[offset+2]=0;buffer[offset+3]=0;
1485 nbytes=(((buffer[16])<<8)+(buffer[17]))-off; /* bytes in ICMP part */
1486 ptr=&(buffer[offset]);
1487 while(nbytes>1){sum += *ptr; ptr++; sum += *ptr <<8; ptr++; nbytes -= 2;}
1488 if(nbytes==1){sum += *ptr;} /* mop up an odd byte, if necessary */
1489 sum = (sum >> 16) + (sum & 0xFFFF);
1490 result=~(sum + (sum >> 16)) & 0xFFFF;
1491 buffer[offset+2]=(result & 0xFF);
1492 buffer[offset+3]=((result >> 8) & 0xFF);
1493 return result;
1494 }
1495 DEFUN(RAWSOCK:ICMPCSUM, buffer &key :START :END) { /* ICMP checksum */
1496 size_t length;
1497 with_buffer_arg(buffer,&STACK_2,&length,PROT_READ,
1498 length = icmpcsum((unsigned char*)buffer,length));
1499 VALUES1(fixnum(length)); skipSTACK(1);
1500 }
1501
tcpcsum(unsigned char * buffer,size_t length)1502 static unsigned short tcpcsum (unsigned char* buffer, size_t length) {
1503 register unsigned long sum; /* assumes long == 32 bits */
1504 unsigned short result;
1505 unsigned char *ptr;
1506 unsigned int nbytes, packsize, offset;
1507 ASSERT(length >= 34); /* FIXME: is this right?! */
1508 sum = (buffer[26]<<8)+ buffer[27]+(buffer[28]<<8)+ buffer[29]; /* Src IP */
1509 sum +=(buffer[30]<<8)+ buffer[31]+(buffer[32]<<8)+ buffer[33]; /* Dst IP */
1510 sum +=(buffer[23]); /* zero followed by protocol */
1511 packsize=((buffer[16])<<8)+(buffer[17]); /* packet size - not including ARP area */
1512 offset=((buffer[14]&0xF)<<2); /* start of TCP header (rel to IP header) */
1513 sum +=(packsize - offset); /* size of TCP part of the packet */
1514 ptr=&(buffer[offset+14]); /* start of TCP header in buffer */
1515 nbytes=packsize-offset; /* number of bytes to checksum */
1516 buffer[offset+16+14]=0;
1517 buffer[offset+17+14]=0; /* initialize TCP checksum to 0 */
1518 while(nbytes>1){sum += *ptr<<8; ptr++; sum += *ptr; ptr++; nbytes -= 2;}
1519 if (nbytes==1) {sum += *ptr<<8;} /* mop up an odd byte, if necessary */
1520 sum = (sum >> 16) + (sum & 0xFFFF);
1521 result=~(sum + (sum >> 16)) & 0xFFFF;
1522 buffer[offset+17+14]=(result & 0xFF);
1523 buffer[offset+16+14]=((result >> 8) & 0xFF);
1524 return result;
1525 }
1526 DEFUN(RAWSOCK:TCPCSUM, buffer &key :START :END) { /* TCP checksum */
1527 size_t length;
1528 with_buffer_arg(buffer,&STACK_2,&length,PROT_READ_WRITE,
1529 length = tcpcsum((unsigned char*)buffer,length));
1530 VALUES1(fixnum(length)); skipSTACK(1);
1531 }
1532
udpcsum(unsigned char * buffer,size_t length)1533 static unsigned short udpcsum (unsigned char* buffer, size_t length) {
1534 register unsigned long sum = 0; /* assumes long == 32 bits */
1535 unsigned short result;
1536 unsigned char *ptr;
1537 unsigned int nbytes, packsize, offset;
1538 ASSERT(length >= 34); /* FIXME: is this right?! */
1539 sum = (buffer[26]<<8)+ buffer[27]+(buffer[28]<<8)+ buffer[29]; /* Src IP */
1540 sum +=(buffer[30]<<8)+ buffer[31]+(buffer[32]<<8)+ buffer[33]; /* Dst IP */
1541 sum +=(buffer[23]); /* zero followed by protocol */
1542 packsize=((buffer[16])<<8)+(buffer[17]); /* packet size */
1543 offset=((buffer[14]&0xF)<<2); /* start of UDP header */
1544 sum +=(((buffer[16])<<8)+(buffer[17])) -offset;
1545 ptr=&(buffer[offset+14]); /* start of TCP header */
1546 nbytes=packsize-offset;
1547 buffer[offset+6+14]=0;
1548 buffer[offset+7+14]=0; /* initialize UDP checksum to 0 */
1549 while(nbytes>1){sum += *ptr <<8; ptr++; sum += *ptr; ptr++; nbytes -= 2;}
1550 if (nbytes==1) {sum += *ptr<<8;} /* mop up an odd byte, if necessary */
1551 sum = (sum >> 16) + (sum & 0xFFFF);
1552 result=~(sum + (sum >> 16)) & 0xFFFF;
1553 buffer[offset+7+14]=(result & 0xFF);
1554 buffer[offset+6+14]=((result >> 8) & 0xFF);
1555 return result;
1556 }
1557 DEFUN(RAWSOCK:UDPCSUM, buffer &key :START :END) { /* UDP checksum */
1558 size_t length;
1559 with_buffer_arg(buffer,&STACK_2,&length,PROT_READ_WRITE,
1560 length = udpcsum((unsigned char*)buffer,length));
1561 VALUES1(fixnum(length)); skipSTACK(1);
1562 }
1563
1564 void module__rawsock__init_function_2 (module_t* module);
module__rawsock__init_function_2(module_t * module)1565 void module__rawsock__init_function_2 (module_t* module) {
1566 module__rawsock__init_function_2__modprep(module);
1567 #if defined(WIN32_NATIVE)
1568 { HMODULE ws2 = LoadLibrary("ws2_32.dll");
1569 if (ws2 != NULL) {
1570 freeaddrinfo_f = (freeaddrinfo_t) GetProcAddress(ws2,"freeaddrinfo");
1571 getaddrinfo_f = (getaddrinfo_t) GetProcAddress(ws2,"getaddrinfo");
1572 getnameinfo_f = (getnameinfo_t) GetProcAddress(ws2,"getnameinfo");
1573 gai_strerror_f = (gai_strerror_t) GetProcAddress(ws2,"gai_strerror");
1574 } }
1575 #endif
1576 }
1577