socket.c 54 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859
  1. /* Copyright 1996-1998,2000-2007,2009,2011-2015,2018,2021,2022
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include <errno.h>
  19. #include <verify.h>
  20. #ifdef HAVE_STDINT_H
  21. #include <stdint.h>
  22. #endif
  23. #include <string.h>
  24. #include <unistd.h>
  25. #include <sys/types.h>
  26. #include <sys/time.h>
  27. #ifdef HAVE_WINSOCK2_H
  28. #include <winsock2.h>
  29. #else /* ! HAVE_WINSOCK2_H */
  30. #include <sys/socket.h>
  31. #include <netinet/in.h>
  32. #include <netinet/tcp.h>
  33. #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  34. #include <sys/un.h>
  35. #endif
  36. #endif /* ! HAVE_WINSOCK2_H */
  37. #include <netdb.h>
  38. #include <arpa/inet.h>
  39. #include "scm.h"
  40. #if SCM_ENABLE_MINI_GMP
  41. #include "mini-gmp.h"
  42. #else
  43. #include <gmp.h>
  44. #endif
  45. #include "arrays.h"
  46. #include "async.h"
  47. #include "bytevectors.h"
  48. #include "dynwind.h"
  49. #include "feature.h"
  50. #include "fports.h"
  51. #include "gsubr.h"
  52. #include "list.h"
  53. #include "modules.h"
  54. #include "numbers.h"
  55. #include "pairs.h"
  56. #include "srfi-13.h"
  57. #include "strings.h"
  58. #include "symbols.h"
  59. #include "syscalls.h"
  60. #include "vectors.h"
  61. #include "socket.h"
  62. #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
  63. #define SUN_LEN(ptr) (offsetof (struct sockaddr_un, sun_path) \
  64. + strlen ((ptr)->sun_path))
  65. #endif
  66. /* The largest possible socket address. Wrapping it in a union guarantees
  67. that the compiler will make it suitably aligned. */
  68. typedef union
  69. {
  70. struct sockaddr sockaddr;
  71. struct sockaddr_in sockaddr_in;
  72. #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  73. struct sockaddr_un sockaddr_un;
  74. #endif
  75. #ifdef HAVE_IPV6
  76. struct sockaddr_in6 sockaddr_in6;
  77. #endif
  78. } scm_t_max_sockaddr;
  79. /* Maximum size of a socket address. */
  80. #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
  81. #ifdef HAVE_INET_NETOF
  82. SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
  83. (SCM address),
  84. "Return the network number part of the given IPv4\n"
  85. "Internet address. E.g.,\n\n"
  86. "@lisp\n"
  87. "(inet-netof 2130706433) @result{} 127\n"
  88. "@end lisp")
  89. #define FUNC_NAME s_scm_inet_netof
  90. {
  91. struct in_addr addr;
  92. addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
  93. return scm_from_ulong (inet_netof (addr));
  94. }
  95. #undef FUNC_NAME
  96. #endif
  97. #ifdef HAVE_INET_LNAOF
  98. SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0,
  99. (SCM address),
  100. "Return the local-address-with-network part of the given\n"
  101. "IPv4 Internet address, using the obsolete class A/B/C system.\n"
  102. "E.g.,\n\n"
  103. "@lisp\n"
  104. "(inet-lnaof 2130706433) @result{} 1\n"
  105. "@end lisp")
  106. #define FUNC_NAME s_scm_lnaof
  107. {
  108. struct in_addr addr;
  109. addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
  110. return scm_from_ulong (inet_lnaof (addr));
  111. }
  112. #undef FUNC_NAME
  113. #endif
  114. #ifdef HAVE_INET_MAKEADDR
  115. SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
  116. (SCM net, SCM lna),
  117. "Make an IPv4 Internet address by combining the network number\n"
  118. "@var{net} with the local-address-within-network number\n"
  119. "@var{lna}. E.g.,\n\n"
  120. "@lisp\n"
  121. "(inet-makeaddr 127 1) @result{} 2130706433\n"
  122. "@end lisp")
  123. #define FUNC_NAME s_scm_inet_makeaddr
  124. {
  125. struct in_addr addr;
  126. unsigned long netnum;
  127. unsigned long lnanum;
  128. netnum = SCM_NUM2ULONG (1, net);
  129. lnanum = SCM_NUM2ULONG (2, lna);
  130. addr = inet_makeaddr (netnum, lnanum);
  131. return scm_from_ulong (ntohl (addr.s_addr));
  132. }
  133. #undef FUNC_NAME
  134. #endif
  135. #ifdef HAVE_IPV6
  136. /* flip a 128 bit IPv6 address between host and network order. */
  137. #ifdef WORDS_BIGENDIAN
  138. #define FLIP_NET_HOST_128(addr)
  139. #else
  140. #define FLIP_NET_HOST_128(addr)\
  141. {\
  142. int i;\
  143. \
  144. for (i = 0; i < 8; i++)\
  145. {\
  146. uint8_t c = (addr)[i];\
  147. \
  148. (addr)[i] = (addr)[15 - i];\
  149. (addr)[15 - i] = c;\
  150. }\
  151. }
  152. #endif
  153. #ifdef WORDS_BIGENDIAN
  154. #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
  155. #else
  156. #define FLIPCPY_NET_HOST_128(dest, src) \
  157. { \
  158. const uint8_t *tmp_srcp = (src) + 15; \
  159. uint8_t *tmp_destp = (dest); \
  160. \
  161. do { \
  162. *tmp_destp++ = *tmp_srcp--; \
  163. } while (tmp_srcp != (src)); \
  164. }
  165. #endif
  166. #if (SIZEOF_UINTPTR_T * SCM_CHAR_BIT) > 128
  167. #error "Assumption that uintptr_t <= 128 bits has been violated."
  168. #endif
  169. #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
  170. #error "Assumption that unsigned long <= 128 bits has been violated."
  171. #endif
  172. #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
  173. #error "Assumption that unsigned long long <= 128 bits has been violated."
  174. #endif
  175. /* convert a 128 bit IPv6 address in network order to a host ordered
  176. SCM integer. */
  177. static SCM
  178. scm_from_ipv6 (const uint8_t *src)
  179. {
  180. mpz_t z;
  181. mpz_init (z);
  182. mpz_import (z,
  183. 1, /* chunk */
  184. 1, /* big-endian chunk ordering */
  185. 16, /* chunks are 16 bytes long */
  186. 1, /* big-endian byte ordering */
  187. 0, /* "nails" -- leading unused bits per chunk */
  188. src);
  189. SCM ret = scm_from_mpz (z);
  190. mpz_clear (z);
  191. return ret;
  192. }
  193. /* convert a host ordered SCM integer to a 128 bit IPv6 address in
  194. network order. */
  195. static void
  196. scm_to_ipv6 (uint8_t dst[16], SCM src)
  197. {
  198. if (SCM_I_INUMP (src))
  199. {
  200. scm_t_signed_bits n = SCM_I_INUM (src);
  201. if (n < 0)
  202. scm_out_of_range (NULL, src);
  203. #ifdef WORDS_BIGENDIAN
  204. memset (dst, 0, 16 - sizeof (scm_t_signed_bits));
  205. memcpy (dst + (16 - sizeof (scm_t_signed_bits)),
  206. &n,
  207. sizeof (scm_t_signed_bits));
  208. #else
  209. memset (dst + sizeof (scm_t_signed_bits),
  210. 0,
  211. 16 - sizeof (scm_t_signed_bits));
  212. /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
  213. a single loop perhaps, similar to the handling of bignums. */
  214. memcpy (dst, &n, sizeof (scm_t_signed_bits));
  215. FLIP_NET_HOST_128 (dst);
  216. #endif
  217. }
  218. else if (SCM_BIGP (src))
  219. {
  220. size_t count;
  221. mpz_t z;
  222. mpz_init (z);
  223. scm_to_mpz (src, z);
  224. if (mpz_sgn (z) < 0 || mpz_sizeinbase (z, 2) > 128)
  225. {
  226. mpz_clear (z);
  227. scm_out_of_range (NULL, src);
  228. }
  229. memset (dst, 0, 16);
  230. mpz_export (dst,
  231. &count,
  232. 1, /* big-endian chunk ordering */
  233. 16, /* chunks are 16 bytes long */
  234. 1, /* big-endian byte ordering */
  235. 0, /* "nails" -- leading unused bits per chunk */
  236. z);
  237. mpz_clear (z);
  238. }
  239. else
  240. scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src, "integer");
  241. }
  242. #endif /* HAVE_IPV6 */
  243. SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
  244. (SCM family, SCM address),
  245. "Convert a network address into a printable string.\n"
  246. "Note that unlike the C version of this function,\n"
  247. "the input is an integer with normal host byte ordering.\n"
  248. "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
  249. "@lisp\n"
  250. "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
  251. "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
  252. " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
  253. "@end lisp")
  254. #define FUNC_NAME s_scm_inet_ntop
  255. {
  256. int af;
  257. #ifdef INET6_ADDRSTRLEN
  258. char dst[INET6_ADDRSTRLEN];
  259. #else
  260. char dst[46];
  261. #endif
  262. const char *result;
  263. af = scm_to_int (family);
  264. SCM_ASSERT_RANGE (1, family,
  265. af == AF_INET
  266. #ifdef HAVE_IPV6
  267. || af == AF_INET6
  268. #endif
  269. );
  270. if (af == AF_INET)
  271. {
  272. uint32_t addr4;
  273. addr4 = htonl (SCM_NUM2ULONG (2, address));
  274. result = inet_ntop (af, &addr4, dst, sizeof (dst));
  275. }
  276. #ifdef HAVE_IPV6
  277. else if (af == AF_INET6)
  278. {
  279. char addr6[16];
  280. scm_to_ipv6 ((uint8_t *) addr6, address);
  281. result = inet_ntop (af, &addr6, dst, sizeof (dst));
  282. }
  283. #endif
  284. else
  285. SCM_MISC_ERROR ("unsupported address family", family);
  286. if (result == NULL)
  287. SCM_SYSERROR;
  288. return scm_from_locale_string (dst);
  289. }
  290. #undef FUNC_NAME
  291. SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
  292. (SCM family, SCM address),
  293. "Convert a string containing a printable network address to\n"
  294. "an integer address. Note that unlike the C version of this\n"
  295. "function,\n"
  296. "the result is an integer with normal host byte ordering.\n"
  297. "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
  298. "@lisp\n"
  299. "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
  300. "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
  301. "@end lisp")
  302. #define FUNC_NAME s_scm_inet_pton
  303. {
  304. int af;
  305. char *src;
  306. uint32_t dst[4];
  307. int rv, eno;
  308. af = scm_to_int (family);
  309. SCM_ASSERT_RANGE (1, family,
  310. af == AF_INET
  311. #ifdef HAVE_IPV6
  312. || af == AF_INET6
  313. #endif
  314. );
  315. src = scm_to_locale_string (address);
  316. rv = inet_pton (af, src, dst);
  317. eno = errno;
  318. free (src);
  319. errno = eno;
  320. if (rv == -1)
  321. SCM_SYSERROR;
  322. else if (rv == 0)
  323. SCM_MISC_ERROR ("Bad address", SCM_EOL);
  324. if (af == AF_INET)
  325. return scm_from_ulong (ntohl (*dst));
  326. #ifdef HAVE_IPV6
  327. else if (af == AF_INET6)
  328. return scm_from_ipv6 ((uint8_t *) dst);
  329. #endif
  330. else
  331. SCM_MISC_ERROR ("unsupported address family", family);
  332. }
  333. #undef FUNC_NAME
  334. SCM_SYMBOL (sym_socket, "socket");
  335. static SCM
  336. scm_socket_fd_to_port (int fd)
  337. {
  338. return scm_i_fdes_to_port (fd, scm_mode_bits ("r+0"), sym_socket,
  339. SCM_FPORT_OPTION_NOT_SEEKABLE);
  340. }
  341. SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
  342. (SCM family, SCM style, SCM proto),
  343. "Return a new socket port of the type specified by @var{family},\n"
  344. "@var{style} and @var{proto}. All three parameters are\n"
  345. "integers. Supported values for @var{family} are\n"
  346. "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
  347. "Typical values for @var{style} are @code{SOCK_STREAM},\n"
  348. "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
  349. "@var{proto} can be obtained from a protocol name using\n"
  350. "@code{getprotobyname}. A value of zero specifies the default\n"
  351. "protocol, which is usually right.\n\n"
  352. "A single socket port cannot be used for communication until it\n"
  353. "has been connected to another socket.")
  354. #define FUNC_NAME s_scm_socket
  355. {
  356. int fd;
  357. fd = socket (scm_to_int (family),
  358. scm_to_int (style),
  359. scm_to_int (proto));
  360. if (fd == -1)
  361. SCM_SYSERROR;
  362. return scm_socket_fd_to_port (fd);
  363. }
  364. #undef FUNC_NAME
  365. #ifdef HAVE_SOCKETPAIR
  366. SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
  367. (SCM family, SCM style, SCM proto),
  368. "Return a pair of connected (but unnamed) socket ports of the\n"
  369. "type specified by @var{family}, @var{style} and @var{proto}.\n"
  370. "Many systems support only socket pairs of the @code{AF_UNIX}\n"
  371. "family. Zero is likely to be the only meaningful value for\n"
  372. "@var{proto}.")
  373. #define FUNC_NAME s_scm_socketpair
  374. {
  375. int fam;
  376. int fd[2];
  377. fam = scm_to_int (family);
  378. if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
  379. SCM_SYSERROR;
  380. return scm_cons (scm_socket_fd_to_port (fd[0]),
  381. scm_socket_fd_to_port (fd[1]));
  382. }
  383. #undef FUNC_NAME
  384. #endif
  385. /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
  386. suitable alignment. */
  387. typedef union
  388. {
  389. #ifdef HAVE_STRUCT_LINGER
  390. struct linger linger;
  391. #endif
  392. size_t size;
  393. int integer;
  394. } scm_t_getsockopt_result;
  395. SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
  396. (SCM sock, SCM level, SCM optname),
  397. "Return an option value from socket port @var{sock}.\n"
  398. "\n"
  399. "@var{level} is an integer specifying a protocol layer, either\n"
  400. "@code{SOL_SOCKET} for socket level options, or a protocol\n"
  401. "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
  402. "(@pxref{Network Databases}).\n"
  403. "\n"
  404. "@defvar SOL_SOCKET\n"
  405. "@defvarx IPPROTO_IP\n"
  406. "@defvarx IPPROTO_TCP\n"
  407. "@defvarx IPPROTO_UDP\n"
  408. "@end defvar\n"
  409. "\n"
  410. "@var{optname} is an integer specifying an option within the\n"
  411. "protocol layer.\n"
  412. "\n"
  413. "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
  414. "defined (when provided by the system). For their meaning see\n"
  415. "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
  416. "Manual}, or @command{man 7 socket}.\n"
  417. "\n"
  418. "@defvar SO_DEBUG\n"
  419. "@defvarx SO_REUSEADDR\n"
  420. "@defvarx SO_STYLE\n"
  421. "@defvarx SO_TYPE\n"
  422. "@defvarx SO_ERROR\n"
  423. "@defvarx SO_DONTROUTE\n"
  424. "@defvarx SO_BROADCAST\n"
  425. "@defvarx SO_SNDBUF\n"
  426. "@defvarx SO_RCVBUF\n"
  427. "@defvarx SO_KEEPALIVE\n"
  428. "@defvarx SO_OOBINLINE\n"
  429. "@defvarx SO_NO_CHECK\n"
  430. "@defvarx SO_PRIORITY\n"
  431. "@defvarx SO_REUSEPORT\n"
  432. "The value returned is an integer.\n"
  433. "@end defvar\n"
  434. "\n"
  435. "@defvar SO_LINGER\n"
  436. "The value returned is a pair of integers\n"
  437. "@code{(@var{enable} . @var{timeout})}. On old systems without\n"
  438. "timeout support (ie.@: without @code{struct linger}), only\n"
  439. "@var{enable} has an effect but the value in Guile is always a\n"
  440. "pair.\n"
  441. "@end defvar"
  442. "\n"
  443. "@defvar SO_RCVTIMEO\n"
  444. "@defvarx SO_SNDTIMEO\n"
  445. "@var{value} is a pair of integers @code{(@var{SECONDS}\n"
  446. ". @var{MICROSECONDS})}.\n"
  447. "@end defvar")
  448. #define FUNC_NAME s_scm_getsockopt
  449. {
  450. int fd;
  451. /* size of optval is the largest supported option. */
  452. scm_t_getsockopt_result optval;
  453. socklen_t optlen = sizeof (optval);
  454. int ilevel;
  455. int ioptname;
  456. memset (&optval, 0, optlen);
  457. sock = SCM_COERCE_OUTPORT (sock);
  458. SCM_VALIDATE_OPFPORT (1, sock);
  459. ilevel = scm_to_int (level);
  460. ioptname = scm_to_int (optname);
  461. fd = SCM_FPORT_FDES (sock);
  462. if (getsockopt (fd, ilevel, ioptname, (void *) &optval, &optlen) == -1)
  463. SCM_SYSERROR;
  464. #if defined(SO_RCVTIMEO) && defined(SO_SNDTIMEO)
  465. if (ioptname == SO_RCVTIMEO || ioptname == SO_SNDTIMEO)
  466. {
  467. struct timeval *opt_time = (struct timeval *) &optval;
  468. return scm_cons (scm_from_long (opt_time->tv_sec),
  469. scm_from_long (opt_time->tv_usec));
  470. }
  471. #endif
  472. if (ilevel == SOL_SOCKET)
  473. {
  474. #ifdef SO_LINGER
  475. if (ioptname == SO_LINGER)
  476. {
  477. #ifdef HAVE_STRUCT_LINGER
  478. struct linger *ling = (struct linger *) &optval;
  479. return scm_cons (scm_from_long (ling->l_onoff),
  480. scm_from_long (ling->l_linger));
  481. #else
  482. return scm_cons (scm_from_long (*(int *) &optval),
  483. scm_from_int (0));
  484. #endif
  485. }
  486. #endif
  487. }
  488. return scm_from_int (*(int *) &optval);
  489. }
  490. #undef FUNC_NAME
  491. SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
  492. (SCM sock, SCM level, SCM optname, SCM value),
  493. "Set an option on socket port @var{sock}. The return value is\n"
  494. "unspecified.\n"
  495. "\n"
  496. "@var{level} is an integer specifying a protocol layer, either\n"
  497. "@code{SOL_SOCKET} for socket level options, or a protocol\n"
  498. "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
  499. "(@pxref{Network Databases}).\n"
  500. "\n"
  501. "@defvar SOL_SOCKET\n"
  502. "@defvarx IPPROTO_IP\n"
  503. "@defvarx IPPROTO_TCP\n"
  504. "@defvarx IPPROTO_UDP\n"
  505. "@end defvar\n"
  506. "\n"
  507. "@var{optname} is an integer specifying an option within the\n"
  508. "protocol layer.\n"
  509. "\n"
  510. "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
  511. "defined (when provided by the system). For their meaning see\n"
  512. "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
  513. "Manual}, or @command{man 7 socket}.\n"
  514. "\n"
  515. "@defvar SO_DEBUG\n"
  516. "@defvarx SO_REUSEADDR\n"
  517. "@defvarx SO_STYLE\n"
  518. "@defvarx SO_TYPE\n"
  519. "@defvarx SO_ERROR\n"
  520. "@defvarx SO_DONTROUTE\n"
  521. "@defvarx SO_BROADCAST\n"
  522. "@defvarx SO_SNDBUF\n"
  523. "@defvarx SO_RCVBUF\n"
  524. "@defvarx SO_KEEPALIVE\n"
  525. "@defvarx SO_OOBINLINE\n"
  526. "@defvarx SO_NO_CHECK\n"
  527. "@defvarx SO_PRIORITY\n"
  528. "@defvarx SO_REUSEPORT\n"
  529. "@var{value} is an integer.\n"
  530. "@end defvar\n"
  531. "\n"
  532. "@defvar SO_LINGER\n"
  533. "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
  534. ". @var{TIMEOUT})}. On old systems without timeout support\n"
  535. "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
  536. "effect but the value in Guile is always a pair.\n"
  537. "@end defvar\n"
  538. "\n"
  539. "@defvar SO_RCVTIMEO\n"
  540. "@defvarx SO_SNDTIMEO\n"
  541. "@var{value} is a pair of integers @code{(@var{SECONDS}\n"
  542. ". @var{MICROSECONDS})}.\n"
  543. "@end defvar\n"
  544. "\n"
  545. "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
  546. "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
  547. "@c \n"
  548. "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
  549. "are defined (when provided by the system). See @command{man\n"
  550. "ip} for what they mean.\n"
  551. "\n"
  552. "@defvar IP_MULTICAST_IF\n"
  553. "This sets the source interface used by multicast traffic.\n"
  554. "@end defvar\n"
  555. "\n"
  556. "@defvar IP_MULTICAST_TTL\n"
  557. "This sets the default TTL for multicast traffic. This defaults \n"
  558. "to 1 and should be increased to allow traffic to pass beyond the\n"
  559. "local network.\n"
  560. "@end defvar\n"
  561. "\n"
  562. "@defvar IP_ADD_MEMBERSHIP\n"
  563. "@defvarx IP_DROP_MEMBERSHIP\n"
  564. "These can be used only with @code{setsockopt}, not\n"
  565. "@code{getsockopt}. @var{value} is a pair\n"
  566. "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
  567. "addresses (@pxref{Network Address Conversion}).\n"
  568. "@var{MULTIADDR} is a multicast address to be added to or\n"
  569. "dropped from the interface @var{INTERFACEADDR}.\n"
  570. "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
  571. "select the interface. @var{INTERFACEADDR} can also be an\n"
  572. "interface index number, on systems supporting that.\n"
  573. "@end defvar")
  574. #define FUNC_NAME s_scm_setsockopt
  575. {
  576. int fd;
  577. int opt_int;
  578. #ifdef HAVE_STRUCT_LINGER
  579. struct linger opt_linger;
  580. #endif
  581. #ifdef HAVE_STRUCT_IP_MREQ
  582. struct ip_mreq opt_mreq;
  583. #endif
  584. struct timeval opt_time;
  585. const void *optval = NULL;
  586. socklen_t optlen = 0;
  587. int ilevel, ioptname;
  588. sock = SCM_COERCE_OUTPORT (sock);
  589. SCM_VALIDATE_OPFPORT (1, sock);
  590. ilevel = scm_to_int (level);
  591. ioptname = scm_to_int (optname);
  592. fd = SCM_FPORT_FDES (sock);
  593. if (ilevel == SOL_SOCKET)
  594. {
  595. #ifdef SO_LINGER
  596. if (ioptname == SO_LINGER)
  597. {
  598. #ifdef HAVE_STRUCT_LINGER
  599. SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
  600. opt_linger.l_onoff = scm_to_int (SCM_CAR (value));
  601. opt_linger.l_linger = scm_to_int (SCM_CDR (value));
  602. optlen = sizeof (struct linger);
  603. optval = &opt_linger;
  604. #else
  605. SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
  606. opt_int = scm_to_int (SCM_CAR (value));
  607. /* timeout is ignored, but may as well validate it. */
  608. scm_to_int (SCM_CDR (value));
  609. optlen = sizeof (int);
  610. optval = &opt_int;
  611. #endif
  612. }
  613. #endif
  614. }
  615. #ifdef HAVE_STRUCT_IP_MREQ
  616. if (ilevel == IPPROTO_IP &&
  617. (ioptname == IP_ADD_MEMBERSHIP || ioptname == IP_DROP_MEMBERSHIP))
  618. {
  619. /* Fourth argument must be a pair of addresses. */
  620. SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
  621. opt_mreq.imr_multiaddr.s_addr = htonl (scm_to_ulong (SCM_CAR (value)));
  622. opt_mreq.imr_interface.s_addr = htonl (scm_to_ulong (SCM_CDR (value)));
  623. optlen = sizeof (opt_mreq);
  624. optval = &opt_mreq;
  625. }
  626. #endif
  627. #if defined(SO_RCVTIMEO) && defined(SO_SNDTIMEO)
  628. if (ioptname == SO_RCVTIMEO || ioptname == SO_SNDTIMEO)
  629. {
  630. SCM_ASSERT_TYPE (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME,
  631. "value");
  632. opt_time.tv_sec = scm_to_ulong (SCM_CAR (value));
  633. opt_time.tv_usec = scm_to_ulong (SCM_CDR (value));
  634. optlen = sizeof (opt_time);
  635. optval = &opt_time;
  636. }
  637. #endif
  638. if (optval == NULL)
  639. {
  640. /* Most options take an int. */
  641. opt_int = scm_to_int (value);
  642. optlen = sizeof (int);
  643. optval = &opt_int;
  644. }
  645. if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
  646. SCM_SYSERROR;
  647. return SCM_UNSPECIFIED;
  648. }
  649. #undef FUNC_NAME
  650. /* Our documentation hard-codes this mapping, so make sure it holds. */
  651. verify (SHUT_RD == 0);
  652. verify (SHUT_WR == 1);
  653. verify (SHUT_RDWR == 2);
  654. SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
  655. (SCM sock, SCM how),
  656. "Sockets can be closed simply by using @code{close-port}. The\n"
  657. "@code{shutdown} procedure allows reception or transmission on a\n"
  658. "connection to be shut down individually, according to the parameter\n"
  659. "@var{how}:\n\n"
  660. "@table @asis\n"
  661. "@item 0\n"
  662. "Stop receiving data for this socket. If further data arrives, reject it.\n"
  663. "@item 1\n"
  664. "Stop trying to transmit data from this socket. Discard any\n"
  665. "data waiting to be sent. Stop looking for acknowledgement of\n"
  666. "data already sent; don't retransmit it if it is lost.\n"
  667. "@item 2\n"
  668. "Stop both reception and transmission.\n"
  669. "@end table\n\n"
  670. "The return value is unspecified.")
  671. #define FUNC_NAME s_scm_shutdown
  672. {
  673. int fd;
  674. sock = SCM_COERCE_OUTPORT (sock);
  675. SCM_VALIDATE_OPFPORT (1, sock);
  676. fd = SCM_FPORT_FDES (sock);
  677. if (shutdown (fd, scm_to_signed_integer (how, 0, 2)) == -1)
  678. SCM_SYSERROR;
  679. return SCM_UNSPECIFIED;
  680. }
  681. #undef FUNC_NAME
  682. /* convert fam/address/args into a sockaddr of the appropriate type.
  683. args is modified by removing the arguments actually used.
  684. which_arg and proc are used when reporting errors:
  685. which_arg is the position of address in the original argument list.
  686. proc is the name of the original procedure.
  687. size returns the size of the structure allocated. */
  688. #define MAX(A, B) ((A) >= (B) ? (A) : (B))
  689. static struct sockaddr *
  690. scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
  691. const char *proc, size_t *size)
  692. #define FUNC_NAME proc
  693. {
  694. switch (fam)
  695. {
  696. case AF_INET:
  697. {
  698. struct sockaddr_in *soka;
  699. unsigned long addr;
  700. int port;
  701. SCM_VALIDATE_ULONG_COPY (which_arg, address, addr);
  702. SCM_VALIDATE_CONS (which_arg + 1, *args);
  703. port = scm_to_int (SCM_CAR (*args));
  704. *args = SCM_CDR (*args);
  705. soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
  706. memset (soka, '\0', sizeof (struct sockaddr_in));
  707. #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
  708. soka->sin_len = sizeof (struct sockaddr_in);
  709. #endif
  710. soka->sin_family = AF_INET;
  711. soka->sin_addr.s_addr = htonl (addr);
  712. soka->sin_port = htons (port);
  713. *size = sizeof (struct sockaddr_in);
  714. return (struct sockaddr *) soka;
  715. }
  716. #ifdef HAVE_IPV6
  717. case AF_INET6:
  718. {
  719. /* see RFC2553. */
  720. int port;
  721. struct sockaddr_in6 *soka;
  722. unsigned long flowinfo = 0;
  723. unsigned long scope_id = 0;
  724. SCM_VALIDATE_CONS (which_arg + 1, *args);
  725. port = scm_to_int (SCM_CAR (*args));
  726. *args = SCM_CDR (*args);
  727. if (scm_is_pair (*args))
  728. {
  729. SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
  730. *args = SCM_CDR (*args);
  731. if (scm_is_pair (*args))
  732. {
  733. SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
  734. scope_id);
  735. *args = SCM_CDR (*args);
  736. }
  737. }
  738. soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
  739. #ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
  740. soka->sin6_len = sizeof (struct sockaddr_in6);
  741. #endif
  742. soka->sin6_family = AF_INET6;
  743. scm_to_ipv6 (soka->sin6_addr.s6_addr, address);
  744. soka->sin6_port = htons (port);
  745. soka->sin6_flowinfo = flowinfo;
  746. #ifdef HAVE_SIN6_SCOPE_ID
  747. soka->sin6_scope_id = scope_id;
  748. #endif
  749. *size = sizeof (struct sockaddr_in6);
  750. return (struct sockaddr *) soka;
  751. }
  752. #endif
  753. #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  754. case AF_UNIX:
  755. {
  756. struct sockaddr_un *soka;
  757. int addr_size;
  758. char *c_address;
  759. size_t c_address_size;
  760. scm_dynwind_begin (0);
  761. c_address = scm_to_locale_stringn (address, &c_address_size);
  762. scm_dynwind_free (c_address);
  763. /* the static buffer size in sockaddr_un seems to be arbitrary
  764. and not necessarily a hard limit. e.g., the glibc manual
  765. suggests it may be possible to declare it size 0. let's
  766. ignore it. if the O/S doesn't like the size it will cause
  767. connect/bind etc., to fail. sun_path is always the last
  768. member of the structure. */
  769. addr_size = sizeof (struct sockaddr_un)
  770. + MAX (0, c_address_size + 1 - (sizeof soka->sun_path));
  771. soka = (struct sockaddr_un *) scm_malloc (addr_size);
  772. memset (soka, 0, addr_size);
  773. soka->sun_family = AF_UNIX;
  774. /* we accept 0-bytes here (used for abstract sockets in Linux);
  775. therefore do not use strlen() or SUN_LEN! */
  776. memcpy (soka->sun_path, c_address, c_address_size);
  777. *size = offsetof (struct sockaddr_un, sun_path) + c_address_size;
  778. scm_dynwind_end ();
  779. return (struct sockaddr *) soka;
  780. }
  781. #endif
  782. default:
  783. scm_out_of_range (proc, scm_from_int (fam));
  784. }
  785. }
  786. #undef FUNC_NAME
  787. SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
  788. (SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
  789. "Initiate a connection from a socket using a specified address\n"
  790. "family to the address\n"
  791. "specified by @var{address} and possibly @var{args}.\n"
  792. "The format required for @var{address}\n"
  793. "and @var{args} depends on the family of the socket.\n\n"
  794. "For a socket of family @code{AF_UNIX},\n"
  795. "only @var{address} is specified and must be a string with the\n"
  796. "filename where the socket is to be created.\n\n"
  797. "For a socket of family @code{AF_INET},\n"
  798. "@var{address} must be an integer IPv4 host address and\n"
  799. "@var{args} must be a single integer port number.\n\n"
  800. "For a socket of family @code{AF_INET6},\n"
  801. "@var{address} must be an integer IPv6 host address and\n"
  802. "@var{args} may be up to three integers:\n"
  803. "port [flowinfo] [scope_id],\n"
  804. "where flowinfo and scope_id default to zero.\n\n"
  805. "Alternatively, the second argument can be a socket address object "
  806. "as returned by @code{make-socket-address}, in which case the "
  807. "no additional arguments should be passed.\n\n"
  808. "Return true, unless the socket was configured to be non-blocking\n"
  809. "and the operation has not finished yet.\n")
  810. #define FUNC_NAME s_scm_connect
  811. {
  812. int fd;
  813. struct sockaddr *soka;
  814. size_t size;
  815. sock = SCM_COERCE_OUTPORT (sock);
  816. SCM_VALIDATE_OPFPORT (1, sock);
  817. fd = SCM_FPORT_FDES (sock);
  818. if (scm_is_eq (address, SCM_UNDEFINED))
  819. /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
  820. `socket address' object. */
  821. soka = scm_to_sockaddr (fam_or_sockaddr, &size);
  822. else
  823. soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
  824. &args, 3, FUNC_NAME, &size);
  825. if (connect (fd, soka, size) == -1)
  826. {
  827. int save_errno = errno;
  828. free (soka);
  829. errno = save_errno;
  830. if (errno == EINPROGRESS || errno == EAGAIN)
  831. return SCM_BOOL_F;
  832. SCM_SYSERROR;
  833. }
  834. free (soka);
  835. return SCM_BOOL_T;
  836. }
  837. #undef FUNC_NAME
  838. SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
  839. (SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
  840. "Assign an address to the socket port @var{sock}.\n"
  841. "Generally this only needs to be done for server sockets,\n"
  842. "so they know where to look for incoming connections. A socket\n"
  843. "without an address will be assigned one automatically when it\n"
  844. "starts communicating.\n\n"
  845. "The format of @var{address} and @var{args} depends\n"
  846. "on the family of the socket.\n\n"
  847. "For a socket of family @code{AF_UNIX}, only @var{address}\n"
  848. "is specified and must be a string with the filename where\n"
  849. "the socket is to be created.\n\n"
  850. "For a socket of family @code{AF_INET}, @var{address}\n"
  851. "must be an integer IPv4 address and @var{args}\n"
  852. "must be a single integer port number.\n\n"
  853. "The values of the following variables can also be used for\n"
  854. "@var{address}:\n\n"
  855. "@defvar INADDR_ANY\n"
  856. "Allow connections from any address.\n"
  857. "@end defvar\n\n"
  858. "@defvar INADDR_LOOPBACK\n"
  859. "The address of the local host using the loopback device.\n"
  860. "@end defvar\n\n"
  861. "@defvar INADDR_BROADCAST\n"
  862. "The broadcast address on the local network.\n"
  863. "@end defvar\n\n"
  864. "@defvar INADDR_NONE\n"
  865. "No address.\n"
  866. "@end defvar\n\n"
  867. "For a socket of family @code{AF_INET6}, @var{address}\n"
  868. "must be an integer IPv6 address and @var{args}\n"
  869. "may be up to three integers:\n"
  870. "port [flowinfo] [scope_id],\n"
  871. "where flowinfo and scope_id default to zero.\n\n"
  872. "Alternatively, the second argument can be a socket address object "
  873. "as returned by @code{make-socket-address}, in which case the "
  874. "no additional arguments should be passed.\n\n"
  875. "The return value is unspecified.")
  876. #define FUNC_NAME s_scm_bind
  877. {
  878. struct sockaddr *soka;
  879. size_t size;
  880. int fd;
  881. sock = SCM_COERCE_OUTPORT (sock);
  882. SCM_VALIDATE_OPFPORT (1, sock);
  883. fd = SCM_FPORT_FDES (sock);
  884. if (scm_is_eq (address, SCM_UNDEFINED))
  885. /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
  886. `socket address' object. */
  887. soka = scm_to_sockaddr (fam_or_sockaddr, &size);
  888. else
  889. soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
  890. &args, 3, FUNC_NAME, &size);
  891. if (bind (fd, soka, size) == -1)
  892. {
  893. int save_errno = errno;
  894. free (soka);
  895. errno = save_errno;
  896. SCM_SYSERROR;
  897. }
  898. free (soka);
  899. return SCM_UNSPECIFIED;
  900. }
  901. #undef FUNC_NAME
  902. SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
  903. (SCM sock, SCM backlog),
  904. "Enable @var{sock} to accept connection\n"
  905. "requests. @var{backlog} is an integer specifying\n"
  906. "the maximum length of the queue for pending connections.\n"
  907. "If the queue fills, new clients will fail to connect until\n"
  908. "the server calls @code{accept} to accept a connection from\n"
  909. "the queue.\n\n"
  910. "The return value is unspecified.")
  911. #define FUNC_NAME s_scm_listen
  912. {
  913. int fd;
  914. sock = SCM_COERCE_OUTPORT (sock);
  915. SCM_VALIDATE_OPFPORT (1, sock);
  916. fd = SCM_FPORT_FDES (sock);
  917. if (listen (fd, scm_to_int (backlog)) == -1)
  918. SCM_SYSERROR;
  919. return SCM_UNSPECIFIED;
  920. }
  921. #undef FUNC_NAME
  922. /* Put the components of a sockaddr into a new SCM vector. */
  923. static SCM_C_INLINE_KEYWORD SCM
  924. _scm_from_sockaddr (const scm_t_max_sockaddr *address, unsigned addr_size,
  925. const char *proc)
  926. {
  927. SCM result = SCM_EOL;
  928. short int fam = ((struct sockaddr *) address)->sa_family;
  929. switch (fam)
  930. {
  931. case AF_INET:
  932. {
  933. const struct sockaddr_in *nad = (struct sockaddr_in *) address;
  934. result = scm_c_make_vector (3, SCM_UNSPECIFIED);
  935. SCM_SIMPLE_VECTOR_SET(result, 0,
  936. scm_from_short (fam));
  937. SCM_SIMPLE_VECTOR_SET(result, 1,
  938. scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
  939. SCM_SIMPLE_VECTOR_SET(result, 2,
  940. scm_from_ushort (ntohs (nad->sin_port)));
  941. }
  942. break;
  943. #ifdef HAVE_IPV6
  944. case AF_INET6:
  945. {
  946. const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
  947. result = scm_c_make_vector (5, SCM_UNSPECIFIED);
  948. SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
  949. SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
  950. SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
  951. SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
  952. #ifdef HAVE_SIN6_SCOPE_ID
  953. SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
  954. #else
  955. SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
  956. #endif
  957. }
  958. break;
  959. #endif
  960. #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  961. case AF_UNIX:
  962. {
  963. const struct sockaddr_un *nad = (struct sockaddr_un *) address;
  964. result = scm_c_make_vector (2, SCM_UNSPECIFIED);
  965. SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
  966. /* When addr_size is not enough to cover sun_path, do not try
  967. to access it. */
  968. if (addr_size <= offsetof (struct sockaddr_un, sun_path))
  969. SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
  970. else
  971. {
  972. size_t path_size = addr_size - offsetof (struct sockaddr_un, sun_path);
  973. SCM_SIMPLE_VECTOR_SET (result, 1,
  974. scm_from_locale_stringn (nad->sun_path,
  975. path_size));
  976. }
  977. }
  978. break;
  979. #endif
  980. default:
  981. result = SCM_UNSPECIFIED;
  982. scm_misc_error (proc, "unrecognised address family: ~A",
  983. scm_list_1 (scm_from_int (fam)));
  984. }
  985. return result;
  986. }
  987. /* The publicly-visible function. Return a Scheme object representing
  988. ADDRESS, an address of ADDR_SIZE bytes. */
  989. SCM
  990. scm_from_sockaddr (const struct sockaddr *address, unsigned addr_size)
  991. {
  992. return (_scm_from_sockaddr ((scm_t_max_sockaddr *) address,
  993. addr_size, "scm_from_sockaddr"));
  994. }
  995. /* Convert ADDRESS, an address object returned by either
  996. `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
  997. representation. On success, a non-NULL pointer is returned and
  998. ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
  999. address. The result must eventually be freed using `free ()'. */
  1000. struct sockaddr *
  1001. scm_to_sockaddr (SCM address, size_t *address_size)
  1002. #define FUNC_NAME "scm_to_sockaddr"
  1003. {
  1004. short int family;
  1005. struct sockaddr *c_address = NULL;
  1006. SCM_VALIDATE_VECTOR (1, address);
  1007. *address_size = 0;
  1008. family = scm_to_short (SCM_SIMPLE_VECTOR_REF (address, 0));
  1009. switch (family)
  1010. {
  1011. case AF_INET:
  1012. {
  1013. if (SCM_SIMPLE_VECTOR_LENGTH (address) != 3)
  1014. scm_misc_error (FUNC_NAME,
  1015. "invalid inet address representation: ~A",
  1016. scm_list_1 (address));
  1017. else
  1018. {
  1019. struct sockaddr_in c_inet;
  1020. memset (&c_inet, '\0', sizeof (struct sockaddr_in));
  1021. #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
  1022. c_inet.sin_len = sizeof (struct sockaddr_in);
  1023. #endif
  1024. c_inet.sin_addr.s_addr =
  1025. htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 1)));
  1026. c_inet.sin_port =
  1027. htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
  1028. c_inet.sin_family = AF_INET;
  1029. *address_size = sizeof (c_inet);
  1030. c_address = scm_malloc (sizeof (c_inet));
  1031. memcpy (c_address, &c_inet, sizeof (c_inet));
  1032. }
  1033. break;
  1034. }
  1035. #ifdef HAVE_IPV6
  1036. case AF_INET6:
  1037. {
  1038. if (SCM_SIMPLE_VECTOR_LENGTH (address) != 5)
  1039. scm_misc_error (FUNC_NAME, "invalid inet6 address representation: ~A",
  1040. scm_list_1 (address));
  1041. else
  1042. {
  1043. struct sockaddr_in6 c_inet6;
  1044. scm_to_ipv6 (c_inet6.sin6_addr.s6_addr,
  1045. SCM_SIMPLE_VECTOR_REF (address, 1));
  1046. c_inet6.sin6_port =
  1047. htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
  1048. c_inet6.sin6_flowinfo =
  1049. scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address, 3));
  1050. #ifdef HAVE_SIN6_SCOPE_ID
  1051. c_inet6.sin6_scope_id =
  1052. scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 4));
  1053. #endif
  1054. c_inet6.sin6_family = AF_INET6;
  1055. *address_size = sizeof (c_inet6);
  1056. c_address = scm_malloc (sizeof (c_inet6));
  1057. memcpy (c_address, &c_inet6, sizeof (c_inet6));
  1058. }
  1059. break;
  1060. }
  1061. #endif
  1062. #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  1063. case AF_UNIX:
  1064. {
  1065. if (SCM_SIMPLE_VECTOR_LENGTH (address) != 2)
  1066. scm_misc_error (FUNC_NAME, "invalid unix address representation: ~A",
  1067. scm_list_1 (address));
  1068. else
  1069. {
  1070. SCM path;
  1071. size_t path_len = 0;
  1072. path = SCM_SIMPLE_VECTOR_REF (address, 1);
  1073. if (!scm_is_string (path) && !scm_is_false (path))
  1074. scm_misc_error (FUNC_NAME, "invalid unix address "
  1075. "path: ~A", scm_list_1 (path));
  1076. else
  1077. {
  1078. struct sockaddr_un c_unix;
  1079. if (scm_is_false (path))
  1080. path_len = 0;
  1081. else
  1082. path_len = scm_c_string_length (path);
  1083. #ifdef UNIX_PATH_MAX
  1084. if (path_len >= UNIX_PATH_MAX)
  1085. #else
  1086. /* We can hope that this limit will eventually vanish, at least on GNU.
  1087. However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
  1088. documents it has being limited to 108 bytes. */
  1089. if (path_len >= sizeof (c_unix.sun_path))
  1090. #endif
  1091. scm_misc_error (FUNC_NAME, "unix address path "
  1092. "too long: ~A", scm_list_1 (path));
  1093. else
  1094. {
  1095. if (path_len)
  1096. {
  1097. scm_to_locale_stringbuf (path, c_unix.sun_path,
  1098. #ifdef UNIX_PATH_MAX
  1099. UNIX_PATH_MAX);
  1100. #else
  1101. sizeof (c_unix.sun_path));
  1102. #endif
  1103. c_unix.sun_path[path_len] = '\0';
  1104. /* Sanity check. */
  1105. if (strlen (c_unix.sun_path) != path_len)
  1106. scm_misc_error (FUNC_NAME, "unix address path "
  1107. "contains nul characters: ~A",
  1108. scm_list_1 (path));
  1109. }
  1110. else
  1111. c_unix.sun_path[0] = '\0';
  1112. c_unix.sun_family = AF_UNIX;
  1113. *address_size = SUN_LEN (&c_unix);
  1114. c_address = scm_malloc (sizeof (c_unix));
  1115. memcpy (c_address, &c_unix, sizeof (c_unix));
  1116. }
  1117. }
  1118. }
  1119. break;
  1120. }
  1121. #endif
  1122. default:
  1123. scm_misc_error (FUNC_NAME, "unrecognised address family: ~A",
  1124. scm_list_1 (scm_from_ushort (family)));
  1125. }
  1126. return c_address;
  1127. }
  1128. #undef FUNC_NAME
  1129. /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
  1130. an address of family FAMILY, with the family-specific parameters ARGS (see
  1131. the description of `connect' for details). The returned structure may be
  1132. freed using `free ()'. */
  1133. struct sockaddr *
  1134. scm_c_make_socket_address (SCM family, SCM address, SCM args,
  1135. size_t *address_size)
  1136. {
  1137. struct sockaddr *soka;
  1138. soka = scm_fill_sockaddr (scm_to_ushort (family), address, &args, 1,
  1139. "scm_c_make_socket_address", address_size);
  1140. return soka;
  1141. }
  1142. SCM_DEFINE (scm_make_socket_address, "make-socket-address", 2, 0, 1,
  1143. (SCM family, SCM address, SCM args),
  1144. "Return a Scheme address object that reflects @var{address}, "
  1145. "being an address of family @var{family}, with the "
  1146. "family-specific parameters @var{args} (see the description of "
  1147. "@code{connect} for details).")
  1148. #define FUNC_NAME s_scm_make_socket_address
  1149. {
  1150. SCM result = SCM_BOOL_F;
  1151. struct sockaddr *c_address;
  1152. size_t c_address_size;
  1153. c_address = scm_c_make_socket_address (family, address, args,
  1154. &c_address_size);
  1155. if (c_address != NULL)
  1156. {
  1157. result = scm_from_sockaddr (c_address, c_address_size);
  1158. free (c_address);
  1159. }
  1160. return result;
  1161. }
  1162. #undef FUNC_NAME
  1163. SCM_DEFINE (scm_accept4, "accept", 1, 1, 0,
  1164. (SCM sock, SCM flags),
  1165. "Accept a connection on a bound, listening socket. If there\n"
  1166. "are no pending connections in the queue, there are two\n"
  1167. "possibilities: if the socket has been configured as\n"
  1168. "non-blocking, return @code{#f} directly. Otherwise wait\n"
  1169. "until a connection is available. When a connection comes,\n"
  1170. "the return value is a pair in which the @emph{car} is a new\n"
  1171. "socket port for the connection and the @emph{cdr} is an\n"
  1172. "object with address information about the client which\n"
  1173. "initiated the connection.\n\n"
  1174. "@var{sock} does not become part of the\n"
  1175. "connection and will continue to accept new requests.")
  1176. #define FUNC_NAME s_scm_accept4
  1177. {
  1178. int fd;
  1179. int newfd;
  1180. int c_flags;
  1181. SCM address;
  1182. SCM newsock;
  1183. socklen_t addr_size = MAX_ADDR_SIZE;
  1184. scm_t_max_sockaddr addr;
  1185. sock = SCM_COERCE_OUTPORT (sock);
  1186. SCM_VALIDATE_OPFPORT (1, sock);
  1187. c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_int (flags);
  1188. fd = SCM_FPORT_FDES (sock);
  1189. SCM_SYSCALL (newfd = accept4 (fd, (struct sockaddr *) &addr, &addr_size,
  1190. c_flags));
  1191. if (newfd == -1)
  1192. {
  1193. if (errno == EAGAIN || errno == EWOULDBLOCK)
  1194. return SCM_BOOL_F;
  1195. SCM_SYSERROR;
  1196. }
  1197. newsock = scm_socket_fd_to_port (newfd);
  1198. address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
  1199. return scm_cons (newsock, address);
  1200. }
  1201. #undef FUNC_NAME
  1202. SCM
  1203. scm_accept (SCM sock)
  1204. {
  1205. return scm_accept4 (sock, SCM_UNDEFINED);
  1206. }
  1207. SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
  1208. (SCM sock),
  1209. "Return the address of @var{sock}, in the same form as the\n"
  1210. "object returned by @code{accept}. On many systems the address\n"
  1211. "of a socket in the @code{AF_FILE} namespace cannot be read.")
  1212. #define FUNC_NAME s_scm_getsockname
  1213. {
  1214. int fd;
  1215. socklen_t addr_size = MAX_ADDR_SIZE;
  1216. scm_t_max_sockaddr addr;
  1217. sock = SCM_COERCE_OUTPORT (sock);
  1218. SCM_VALIDATE_OPFPORT (1, sock);
  1219. fd = SCM_FPORT_FDES (sock);
  1220. if (getsockname (fd, (struct sockaddr *) &addr, &addr_size) == -1)
  1221. SCM_SYSERROR;
  1222. return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
  1223. }
  1224. #undef FUNC_NAME
  1225. SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
  1226. (SCM sock),
  1227. "Return the address that @var{sock}\n"
  1228. "is connected to, in the same form as the object returned by\n"
  1229. "@code{accept}. On many systems the address of a socket in the\n"
  1230. "@code{AF_FILE} namespace cannot be read.")
  1231. #define FUNC_NAME s_scm_getpeername
  1232. {
  1233. int fd;
  1234. socklen_t addr_size = MAX_ADDR_SIZE;
  1235. scm_t_max_sockaddr addr;
  1236. sock = SCM_COERCE_OUTPORT (sock);
  1237. SCM_VALIDATE_OPFPORT (1, sock);
  1238. fd = SCM_FPORT_FDES (sock);
  1239. if (getpeername (fd, (struct sockaddr *) &addr, &addr_size) == -1)
  1240. SCM_SYSERROR;
  1241. return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
  1242. }
  1243. #undef FUNC_NAME
  1244. SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
  1245. (SCM sock, SCM buf, SCM flags),
  1246. "Receive data from a socket port.\n"
  1247. "@var{sock} must already\n"
  1248. "be bound to the address from which data is to be received.\n"
  1249. "@var{buf} is a bytevector into which\n"
  1250. "the data will be written. The size of @var{buf} limits\n"
  1251. "the amount of\n"
  1252. "data which can be received: in the case of packet\n"
  1253. "protocols, if a packet larger than this limit is encountered\n"
  1254. "then some data\n"
  1255. "will be irrevocably lost.\n\n"
  1256. "The optional @var{flags} argument is a value or\n"
  1257. "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
  1258. "The value returned is the number of bytes read from the\n"
  1259. "socket.\n\n"
  1260. "Note that the data is read directly from the socket file\n"
  1261. "descriptor:\n"
  1262. "any unread buffered port data is ignored.")
  1263. #define FUNC_NAME s_scm_recv
  1264. {
  1265. int rv, fd, flg;
  1266. SCM_VALIDATE_OPFPORT (1, sock);
  1267. if (SCM_UNBNDP (flags))
  1268. flg = 0;
  1269. else
  1270. flg = scm_to_int (flags);
  1271. fd = SCM_FPORT_FDES (sock);
  1272. SCM_VALIDATE_BYTEVECTOR (1, buf);
  1273. SCM_SYSCALL (rv = recv (fd,
  1274. SCM_BYTEVECTOR_CONTENTS (buf),
  1275. SCM_BYTEVECTOR_LENGTH (buf),
  1276. flg));
  1277. if (SCM_UNLIKELY (rv == -1))
  1278. SCM_SYSERROR;
  1279. scm_remember_upto_here (buf);
  1280. return scm_from_int (rv);
  1281. }
  1282. #undef FUNC_NAME
  1283. SCM_DEFINE (scm_send, "send", 2, 1, 0,
  1284. (SCM sock, SCM message, SCM flags),
  1285. "Transmit bytevector @var{message} on socket port @var{sock}.\n"
  1286. "@var{sock} must already be bound to a destination address. The\n"
  1287. "value returned is the number of bytes transmitted --\n"
  1288. "it's possible for\n"
  1289. "this to be less than the length of @var{message}\n"
  1290. "if the socket is\n"
  1291. "set to be non-blocking. The optional @var{flags} argument\n"
  1292. "is a value or\n"
  1293. "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
  1294. "Note that the data is written directly to the socket\n"
  1295. "file descriptor:\n"
  1296. "any unflushed buffered port data is ignored.\n\n"
  1297. "This operation is defined only for strings containing codepoints\n"
  1298. "zero to 255.")
  1299. #define FUNC_NAME s_scm_send
  1300. {
  1301. int rv, fd, flg;
  1302. sock = SCM_COERCE_OUTPORT (sock);
  1303. SCM_VALIDATE_OPFPORT (1, sock);
  1304. if (SCM_UNBNDP (flags))
  1305. flg = 0;
  1306. else
  1307. flg = scm_to_int (flags);
  1308. fd = SCM_FPORT_FDES (sock);
  1309. SCM_VALIDATE_BYTEVECTOR (1, message);
  1310. SCM_SYSCALL (rv = send (fd,
  1311. SCM_BYTEVECTOR_CONTENTS (message),
  1312. SCM_BYTEVECTOR_LENGTH (message),
  1313. flg));
  1314. if (rv == -1)
  1315. SCM_SYSERROR;
  1316. scm_remember_upto_here_1 (message);
  1317. return scm_from_int (rv);
  1318. }
  1319. #undef FUNC_NAME
  1320. SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
  1321. (SCM sock, SCM buf, SCM flags, SCM start, SCM end),
  1322. "Receive data from socket port @var{sock} (which must be already\n"
  1323. "bound), returning the originating address as well as the data.\n"
  1324. "This is usually for use on datagram sockets, but can be used on\n"
  1325. "stream-oriented sockets too.\n"
  1326. "\n"
  1327. "The data received is stored in bytevector @var{buf}, using\n"
  1328. "either the whole bytevector or just the region between the optional\n"
  1329. "@var{start} and @var{end} positions. The size of @var{buf}\n"
  1330. "limits the amount of data that can be received. For datagram\n"
  1331. "protocols, if a packet larger than this is received then excess\n"
  1332. "bytes are irrevocably lost.\n"
  1333. "\n"
  1334. "The return value is a pair. The @code{car} is the number of\n"
  1335. "bytes read. The @code{cdr} is a socket address object which is\n"
  1336. "where the data came from, or @code{#f} if the origin is\n"
  1337. "unknown.\n"
  1338. "\n"
  1339. "The optional @var{flags} argument is a or bitwise OR\n"
  1340. "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
  1341. "@code{MSG_DONTROUTE} etc.\n"
  1342. "\n"
  1343. "Data is read directly from the socket file descriptor, any\n"
  1344. "buffered port data is ignored.\n"
  1345. "\n"
  1346. "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
  1347. "all threads stop while a @code{recvfrom!} call is in progress.\n"
  1348. "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
  1349. "or @code{MSG_DONTWAIT} to avoid this.")
  1350. #define FUNC_NAME s_scm_recvfrom
  1351. {
  1352. int rv, fd, flg;
  1353. SCM address;
  1354. size_t offset, cend;
  1355. socklen_t addr_size = MAX_ADDR_SIZE;
  1356. scm_t_max_sockaddr addr;
  1357. SCM_VALIDATE_OPFPORT (1, sock);
  1358. fd = SCM_FPORT_FDES (sock);
  1359. if (SCM_UNBNDP (flags))
  1360. flg = 0;
  1361. else
  1362. SCM_VALIDATE_ULONG_COPY (3, flags, flg);
  1363. ((struct sockaddr *) &addr)->sa_family = AF_UNSPEC;
  1364. SCM_VALIDATE_BYTEVECTOR (1, buf);
  1365. if (SCM_UNBNDP (end))
  1366. cend = SCM_BYTEVECTOR_LENGTH (buf);
  1367. else
  1368. {
  1369. cend = scm_to_size_t (end);
  1370. if (SCM_UNLIKELY (cend > SCM_BYTEVECTOR_LENGTH (buf)))
  1371. scm_out_of_range (FUNC_NAME, end);
  1372. }
  1373. if (SCM_UNBNDP (start))
  1374. offset = 0;
  1375. else
  1376. {
  1377. offset = scm_to_size_t (start);
  1378. if (SCM_UNLIKELY (cend < offset))
  1379. scm_out_of_range (FUNC_NAME, start);
  1380. }
  1381. SCM_SYSCALL (rv = recvfrom (fd,
  1382. SCM_BYTEVECTOR_CONTENTS (buf) + offset,
  1383. cend - offset, flg,
  1384. (struct sockaddr *) &addr, &addr_size));
  1385. if (rv == -1)
  1386. SCM_SYSERROR;
  1387. /* `recvfrom' does not necessarily return an address. Usually nothing
  1388. is returned for stream sockets. */
  1389. if (((struct sockaddr *) &addr)->sa_family != AF_UNSPEC)
  1390. address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
  1391. else
  1392. address = SCM_BOOL_F;
  1393. scm_remember_upto_here_1 (buf);
  1394. return scm_cons (scm_from_int (rv), address);
  1395. }
  1396. #undef FUNC_NAME
  1397. SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
  1398. (SCM sock, SCM message, SCM fam_or_sockaddr, SCM address, SCM args_and_flags),
  1399. "Transmit bytevector @var{message} on socket port\n"
  1400. "@var{sock}. The\n"
  1401. "destination address is specified using the @var{fam_or_sockaddr},\n"
  1402. "@var{address} and\n"
  1403. "@var{args_and_flags} arguments, or just a socket address object "
  1404. "returned by @code{make-socket-address}, in a similar way to the\n"
  1405. "@code{connect} procedure. @var{args_and_flags} contains\n"
  1406. "the usual connection arguments optionally followed by\n"
  1407. "a flags argument, which is a value or\n"
  1408. "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
  1409. "The value returned is the number of bytes transmitted --\n"
  1410. "it's possible for\n"
  1411. "this to be less than the length of @var{message} if the\n"
  1412. "socket is\n"
  1413. "set to be non-blocking.\n"
  1414. "Note that the data is written directly to the socket\n"
  1415. "file descriptor:\n"
  1416. "any unflushed buffered port data is ignored.\n"
  1417. "This operation is defined only for strings containing codepoints\n"
  1418. "zero to 255.")
  1419. #define FUNC_NAME s_scm_sendto
  1420. {
  1421. int rv, fd, flg;
  1422. struct sockaddr *soka;
  1423. size_t size;
  1424. sock = SCM_COERCE_OUTPORT (sock);
  1425. SCM_VALIDATE_FPORT (1, sock);
  1426. fd = SCM_FPORT_FDES (sock);
  1427. if (!scm_is_number (fam_or_sockaddr))
  1428. {
  1429. /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
  1430. means that the following arguments, i.e. ADDRESS and those listed in
  1431. ARGS_AND_FLAGS, are the `MSG_' flags. */
  1432. soka = scm_to_sockaddr (fam_or_sockaddr, &size);
  1433. if (!scm_is_eq (address, SCM_UNDEFINED))
  1434. args_and_flags = scm_cons (address, args_and_flags);
  1435. }
  1436. else
  1437. soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
  1438. &args_and_flags, 3, FUNC_NAME, &size);
  1439. if (scm_is_null (args_and_flags))
  1440. flg = 0;
  1441. else
  1442. {
  1443. SCM_VALIDATE_CONS (5, args_and_flags);
  1444. flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
  1445. }
  1446. SCM_VALIDATE_BYTEVECTOR (1, message);
  1447. SCM_SYSCALL (rv = sendto (fd,
  1448. SCM_BYTEVECTOR_CONTENTS (message),
  1449. SCM_BYTEVECTOR_LENGTH (message),
  1450. flg, soka, size));
  1451. if (rv == -1)
  1452. {
  1453. int save_errno = errno;
  1454. free (soka);
  1455. errno = save_errno;
  1456. SCM_SYSERROR;
  1457. }
  1458. free (soka);
  1459. scm_remember_upto_here_1 (message);
  1460. return scm_from_int (rv);
  1461. }
  1462. #undef FUNC_NAME
  1463. void
  1464. scm_init_socket ()
  1465. {
  1466. /* protocol families. */
  1467. #ifdef AF_UNSPEC
  1468. scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC));
  1469. #endif
  1470. #if defined HAVE_UNIX_DOMAIN_SOCKETS && defined AF_UNIX
  1471. scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX));
  1472. #endif
  1473. #ifdef AF_INET
  1474. scm_c_define ("AF_INET", scm_from_int (AF_INET));
  1475. #endif
  1476. #ifdef AF_INET6
  1477. scm_c_define ("AF_INET6", scm_from_int (AF_INET6));
  1478. #endif
  1479. #ifdef PF_UNSPEC
  1480. scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC));
  1481. #endif
  1482. #ifdef PF_UNIX
  1483. scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX));
  1484. #endif
  1485. #ifdef PF_INET
  1486. scm_c_define ("PF_INET", scm_from_int (PF_INET));
  1487. #endif
  1488. #ifdef PF_INET6
  1489. scm_c_define ("PF_INET6", scm_from_int (PF_INET6));
  1490. #endif
  1491. /* standard addresses. */
  1492. #ifdef INADDR_ANY
  1493. scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY));
  1494. scm_c_define ("IN6ADDR_ANY", scm_from_ulong (0));
  1495. #endif
  1496. #ifdef INADDR_BROADCAST
  1497. scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST));
  1498. #endif
  1499. #ifdef INADDR_NONE
  1500. scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE));
  1501. #endif
  1502. #ifdef INADDR_LOOPBACK
  1503. scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK));
  1504. scm_c_define ("IN6ADDR_LOOPBACK", scm_from_ulong (1));
  1505. #endif
  1506. /* socket types.
  1507. SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
  1508. packet(7) advise that it's obsolete and strongly deprecated. */
  1509. #ifdef SOCK_STREAM
  1510. scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM));
  1511. #endif
  1512. #ifdef SOCK_DGRAM
  1513. scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM));
  1514. #endif
  1515. #ifdef SOCK_SEQPACKET
  1516. scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET));
  1517. #endif
  1518. #ifdef SOCK_RAW
  1519. scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW));
  1520. #endif
  1521. #ifdef SOCK_RDM
  1522. scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM));
  1523. #endif
  1524. /* accept4 flags. */
  1525. #ifdef SOCK_CLOEXEC
  1526. scm_c_define ("SOCK_CLOEXEC", scm_from_int (SOCK_CLOEXEC));
  1527. #endif
  1528. #ifdef SOCK_NONBLOCK
  1529. scm_c_define ("SOCK_NONBLOCK", scm_from_int (SOCK_NONBLOCK));
  1530. #endif
  1531. /* setsockopt level.
  1532. SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
  1533. instance NetBSD. We define IPPROTOs because that's what the posix spec
  1534. shows in its example at
  1535. http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
  1536. */
  1537. #ifdef SOL_SOCKET
  1538. scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET));
  1539. #endif
  1540. #ifdef IPPROTO_IP
  1541. scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP));
  1542. #endif
  1543. #ifdef IPPROTO_IPV6
  1544. scm_c_define ("IPPROTO_IPV6", scm_from_int (IPPROTO_IPV6));
  1545. #endif
  1546. #ifdef IPPROTO_TCP
  1547. scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP));
  1548. #endif
  1549. #ifdef IPPROTO_UDP
  1550. scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP));
  1551. #endif
  1552. /* setsockopt names. */
  1553. #ifdef SO_DEBUG
  1554. scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG));
  1555. #endif
  1556. #ifdef SO_REUSEADDR
  1557. scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR));
  1558. #endif
  1559. #ifdef SO_STYLE
  1560. scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE));
  1561. #endif
  1562. #ifdef SO_TYPE
  1563. scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE));
  1564. #endif
  1565. #ifdef SO_ERROR
  1566. scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR));
  1567. #endif
  1568. #ifdef SO_DONTROUTE
  1569. scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE));
  1570. #endif
  1571. #ifdef SO_BROADCAST
  1572. scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST));
  1573. #endif
  1574. #ifdef SO_SNDBUF
  1575. scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF));
  1576. #endif
  1577. #ifdef SO_RCVBUF
  1578. scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF));
  1579. #endif
  1580. #ifdef SO_KEEPALIVE
  1581. scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE));
  1582. #endif
  1583. #ifdef SO_OOBINLINE
  1584. scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE));
  1585. #endif
  1586. #ifdef SO_NO_CHECK
  1587. scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK));
  1588. #endif
  1589. #ifdef SO_PRIORITY
  1590. scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY));
  1591. #endif
  1592. #ifdef SO_LINGER
  1593. scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER));
  1594. #endif
  1595. #ifdef SO_REUSEPORT /* new in Linux 3.9 */
  1596. scm_c_define ("SO_REUSEPORT", scm_from_int (SO_REUSEPORT));
  1597. #endif
  1598. #ifdef SO_RCVTIMEO
  1599. scm_c_define ("SO_RCVTIMEO", scm_from_int (SO_RCVTIMEO));
  1600. #endif
  1601. #ifdef SO_SNDTIMEO
  1602. scm_c_define ("SO_SNDTIMEO", scm_from_int (SO_SNDTIMEO));
  1603. #endif
  1604. /* recv/send options. */
  1605. #ifdef MSG_DONTWAIT
  1606. scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT));
  1607. #endif
  1608. #ifdef MSG_OOB
  1609. scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB));
  1610. #endif
  1611. #ifdef MSG_PEEK
  1612. scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK));
  1613. #endif
  1614. #ifdef MSG_DONTROUTE
  1615. scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE));
  1616. #endif
  1617. /* TCP options. */
  1618. #ifdef TCP_NODELAY
  1619. scm_c_define ("TCP_NODELAY", scm_from_int (TCP_NODELAY));
  1620. #endif
  1621. #ifdef TCP_CORK
  1622. scm_c_define ("TCP_CORK", scm_from_int (TCP_CORK));
  1623. #endif
  1624. #ifdef IP_ADD_MEMBERSHIP
  1625. scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
  1626. scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
  1627. #endif
  1628. #ifdef IP_MULTICAST_TTL
  1629. scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL));
  1630. #endif
  1631. #ifdef IP_MULTICAST_IF
  1632. scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF));
  1633. #endif
  1634. #ifdef IPV6_V6ONLY
  1635. scm_c_define ("IPV6_V6ONLY", scm_from_int (IPV6_V6ONLY));
  1636. #endif
  1637. scm_add_feature ("socket");
  1638. #include "socket.x"
  1639. }