YAP 7.1.0
ypsocks.c
1/*************************************************************************
2* *
3* YAP Prolog %W% %G%
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: io.h *
12* Last rev: 19/2/88 *
13* mods: *
14* comments: control YAP from sockets. *
15* *
16*************************************************************************/
17
18#include "sysbits.h"
19
20#if HAVE_SOCKET
21
22#if HAVE_UNISTD_H && !defined(__MINGW32__) && !_MSC_VER
23#include <unistd.h>
24#endif
25#if STDC_HEADERS
26#include <stdlib.h>
27#endif
28#if HAVE_SYS_TYPES_H
29#include <sys/types.h>
30#endif
31#if HAVE_SYS_TIME_H && !defined(__MINGW32__) && !_MSC_VER
32#include <sys/time.h>
33#endif
34#ifdef _WIN32
35#if HAVE_IO_H
36#include <io.h>
37#endif
38#endif
39#if _MSC_VER || defined(__MINGW32__)
40#include <io.h>
41#include <winsock2.h>
42#else
43#if HAVE_SYS_SOCKET_H
44#include <sys/socket.h>
45#endif
46#if HAVE_SYS_UN_H
47#include <sys/un.h>
48#endif
49#if HAVE_NETDB_H
50#include <netdb.h>
51#endif
52#if HAVE_NETINET_IN_H
53#include <netinet/in.h>
54#endif
55#if HAVE_ARPA_INET_H
56#include <arpa/inet.h>
57#endif
58#if HAVE_FCNTL_H
59#include <fcntl.h>
60#endif
61#if HAVE_STRING_H
62#include <string.h>
63#endif
64#if HAVE_SYS_SELECT_H
65#include <sys/select.h>
66#endif
67#if HAVE_SYS_PARAM_H
68#include <sys/param.h>
69#endif
70#endif
71#ifdef _WIN32
72//#include <ws2tcpip.h>
73typedef int socklen_t;
74#endif
75/* make sure we can compile in any platform */
76#ifndef AF_UNSPEC
77#define AF_UNSPEC 0
78#endif
79#ifndef AF_LOCAL
80#define AF_LOCAL AF_UNSPEC
81#endif
82#ifndef AF_AAL5
83#define AF_AAL5 AF_UNSPEC
84#endif
85#ifndef AF_APPLETALK
86#define AF_APPLETALK AF_UNSPEC
87#endif
88#ifndef AF_AX25
89#define AF_AX25 AF_UNSPEC
90#endif
91#ifndef AF_BRIDGE
92#define AF_BRIDGE AF_UNSPEC
93#endif
94#ifndef AF_DECnet
95#define AF_DECnet AF_UNSPEC
96#endif
97#ifndef AF_FILE
98#define AF_FILE AF_UNSPEC
99#endif
100#ifndef AF_INET
101#define AF_INET AF_UNSPEC
102#endif
103#ifndef AF_INET6
104#define AF_INET6 AF_UNSPEC
105#endif
106#ifndef AF_IPX
107#define AF_IPX AF_UNSPEC
108#endif
109#ifndef AF_LOCAL
110#define AF_LOCAL AF_UNSPEC
111#endif
112#ifndef AF_NETBEUI
113#define AF_NETBEUI AF_UNSPEC
114#endif
115#ifndef AF_NETLINK
116#define AF_NETLINK AF_UNSPEC
117#endif
118#ifndef AF_NETROM
119#define AF_NETROM AF_UNSPEC
120#endif
121#ifndef AF_OSINET
122#define AF_OSINET AF_UNSPEC
123#endif
124#ifndef AF_PACKET
125#define AF_PACKET AF_UNSPEC
126#endif
127#ifndef AF_ROSE
128#define AF_ROSE AF_UNSPEC
129#endif
130#ifndef AF_ROUTE
131#define AF_ROUTE AF_UNSPEC
132#endif
133#ifndef AF_SECURITY
134#define AF_SECURITY AF_UNSPEC
135#endif
136#ifndef AF_SNA
137#define AF_SNA AF_UNSPEC
138#endif
139#ifndef AF_UNIX
140#define AF_UNIX AF_UNSPEC
141#endif
142#ifndef AF_X25
143#define AF_X25 AF_UNSPEC
144#endif
145
146#ifndef SOCK_STREAM
147#define SOCK_STREAM -1
148#endif
149#ifndef SOCK_DGRAM
150#define SOCK_DGRAM -1
151#endif
152#ifndef SOCK_RAW
153#define SOCK_RAW -1
154#endif
155#ifndef SOCK_RDM
156#define SOCK_RDM -1
157#endif
158#ifndef SOCK_SEQPACKET
159#define SOCK_SEQPACKET -1
160#endif
161#ifndef SOCK_PACKET
162#define SOCK_PACKET -1
163#endif
164
165#ifndef MAXHOSTNAMELEN
166#define MAXHOSTNAMELEN 256
167#endif
168
169#ifndef BUFSIZ
170#define BUFSIZ 256
171#endif
172
173#if _MSC_VER || defined(__MINGW32__)
174#define socket_errno WSAGetLastError()
175#define invalid_socket_fd(fd) (fd) == INVALID_SOCKET
176#else
177#define socket_errno errno
178#define invalid_socket_fd(fd) (fd) < 0
179#endif
180
181void Yap_init_socks(char *host, long interface_port) {
182 int s;
183 int r;
184 struct sockaddr_in soadr;
185 struct in_addr adr;
186 struct hostent *he;
187
188#if HAVE_SOCKET
189 he = gethostbyname(host);
190 if (he == NULL) {
191#if HAVE_STRERROR
192 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
193 "can not get address for host %s: %s", host, strerror(h_errno));
194#else
195 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "can not get address for host");
196#endif
197 return;
198 }
199
200 (void)memset((void *)&soadr, '\0', sizeof(struct sockaddr_in));
201 soadr.sin_family = AF_INET;
202 soadr.sin_port = htons((short)interface_port);
203
204 if (he != NULL) {
205 memmove((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length);
206 } else {
207 adr.s_addr = inet_addr(host);
208 }
209 soadr.sin_addr.s_addr = adr.s_addr;
210
211 s = socket(AF_INET, SOCK_STREAM, 0);
212 if (s < 0) {
213#if HAVE_STRERROR
214 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket: %s",
215 strerror(errno));
216#else
217 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket");
218#endif
219 return;
220 }
221
222#if ENABLE_SO_LINGER
223 struct linger ling; /* disables socket lingering. */
224 ling.l_onoff = 1;
225 ling.l_linger = 0;
226 if (setsockopt(s, SOL_SOCKET, SO_LINGER, (void *)&ling, sizeof(ling)) < 0) {
227#if HAVE_STRERROR
228 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
229 "socket_connect/3 (setsockopt_linger: %s)",
230 strerror(socket_errno));
231#else
232 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
233 "socket_connect/3 (setsockopt_linger)");
234#endif
235 return;
236 }
237#endif
238
239 r = connect(s, (struct sockaddr *)&soadr, sizeof(soadr));
240 if (r < 0) {
241#if HAVE_STRERROR
242 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
243 "connect failed, could not connect to interface: %s",
244 strerror(errno));
245#else
246 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
247 "connect failed, could not connect to interface");
248#endif
249 return;
250 }
251/* now reopen stdin stdout and stderr */
252#if HAVE_DUP2 && !defined(__MINGW32__)
253 if (dup2(s, 0) < 0) {
254#if HAVE_STRERROR
255 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin: %s",
256 strerror(errno));
257#else
258 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin");
259#endif
260 return;
261 }
262 if (dup2(s, 1) < 0) {
263#if HAVE_STRERROR
264 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout: %s",
265 strerror(errno));
266#else
267 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout");
268#endif
269 return;
270 }
271 if (dup2(s, 2) < 0) {
272#if HAVE_STRERROR
273 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr: %s",
274 strerror(errno));
275#else
276 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr");
277#endif
278 return;
279 }
280#elif _MSC_VER || defined(__MINGW32__)
281 if (_dup2(s, 0) < 0) {
282 fprintf(stderr, "could not dup2 stdin\n");
283 return;
284 }
285 if (_dup2(s, 1) < 0) {
286 fprintf(stderr, "could not dup2 stdout\n");
287 return;
288 }
289 if (_dup2(s, 2) < 0) {
290 fprintf(stderr, "could not dup2 stderr\n");
291 return;
292 }
293#else
294 if (dup2(s, 0) < 0) {
295 fprintf(stderr, "could not dup2 stdin\n");
296 return;
297 }
298 yp_iob[0].cnt = 0;
299 yp_iob[0].flags = _YP_IO_SOCK | _YP_IO_READ;
300 if (dup2(s, 1) < 0) {
301 fprintf(stderr, "could not dup2 stdout\n");
302 return;
303 }
304 yp_iob[1].cnt = 0;
305 yp_iob[1].flags = _YP_IO_SOCK | _YP_IO_WRITE;
306 if (dup2(s, 2) < 0) {
307 fprintf(stderr, "could not dup2 stderr\n");
308 return;
309 }
310 yp_iob[2].cnt = 0;
311 yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE;
312#endif
313// Yap_sockets_io = 1;
314#if _MSC_VER || defined(__MINGW32__)
315 _close(s);
316#else
317 close(s);
318#endif
319#else /* HAVE_SOCKET */
320 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sockets not installed",
321 strerror(errno));
322#endif /* HAVE_SOCKET */
323}
324
325static Int p_socket(USES_REGS1) {
326 Term t1 = Deref(ARG1);
327 Term t2 = Deref(ARG2);
328 Term t3 = Deref(ARG3);
329 char *sdomain, *stype;
330 Int domain = AF_UNSPEC, type, protocol;
331 int fd;
332 Term out;
333
334 if (IsVarTerm(t1)) {
335 Yap_Error(INSTANTIATION_ERROR, t1, "socket/4");
336 return (FALSE);
337 }
338 if (!IsAtomTerm(t1)) {
339 Yap_Error(TYPE_ERROR_ATOM, t1, "socket/4");
340 return (FALSE);
341 }
342 if (IsVarTerm(t2)) {
343 Yap_Error(INSTANTIATION_ERROR, t2, "socket/4");
344 return (FALSE);
345 }
346 if (!IsAtomTerm(t2)) {
347 Yap_Error(TYPE_ERROR_ATOM, t2, "socket/4");
348 return (FALSE);
349 }
350 if (IsVarTerm(t3)) {
351 Yap_Error(INSTANTIATION_ERROR, t3, "socket/4");
352 return (FALSE);
353 }
354 if (!IsIntTerm(t3)) {
355 Yap_Error(TYPE_ERROR_ATOM, t3, "socket/4");
356 return (FALSE);
357 }
358 sdomain = RepAtom(AtomOfTerm(t1))->StrOfAE;
359 if (sdomain[0] != 'A' || sdomain[1] != 'F' || sdomain[2] != '_')
360 return (FALSE); /* Error */
361 sdomain += 3;
362 switch (sdomain[0]) {
363 case 'A':
364 if (strcmp(sdomain, "AAL5") == 0)
365 domain = AF_AAL5;
366 else if (strcmp(sdomain, "APPLETALK") == 0)
367 domain = AF_APPLETALK;
368 else if (strcmp(sdomain, "AX25") == 0)
369 domain = AF_AX25;
370 break;
371 case 'B':
372 if (strcmp(sdomain, "BRIDGE") == 0)
373 domain = AF_APPLETALK;
374 break;
375 case 'D':
376 if (strcmp(sdomain, "DECnet") == 0)
377 domain = AF_DECnet;
378 break;
379 case 'F':
380 if (strcmp(sdomain, "FILE") == 0)
381 domain = AF_FILE;
382 break;
383 case 'I':
384 if (strcmp(sdomain, "INET") == 0)
385 domain = AF_INET;
386 else if (strcmp(sdomain, "INET6") == 0)
387 domain = AF_INET6;
388 else if (strcmp(sdomain, "IPX") == 0)
389 domain = AF_IPX;
390 break;
391 case 'L':
392 if (strcmp(sdomain, "LOCAL") == 0)
393 domain = AF_LOCAL;
394 break;
395 case 'N':
396 if (strcmp(sdomain, "NETBEUI") == 0)
397 domain = AF_NETBEUI;
398 else if (strcmp(sdomain, "NETLINK") == 0)
399 domain = AF_NETLINK;
400 else if (strcmp(sdomain, "NETROM") == 0)
401 domain = AF_NETROM;
402 break;
403 case 'O':
404 if (strcmp(sdomain, "OSINET") == 0)
405 domain = AF_OSINET;
406 break;
407 case 'P':
408 if (strcmp(sdomain, "PACKET") == 0)
409 domain = AF_PACKET;
410 break;
411 case 'R':
412 if (strcmp(sdomain, "ROSE") == 0)
413 domain = AF_ROSE;
414 else if (strcmp(sdomain, "ROUTE") == 0)
415 domain = AF_ROUTE;
416 break;
417 case 'S':
418 if (strcmp(sdomain, "SECURITY") == 0)
419 domain = AF_SECURITY;
420 else if (strcmp(sdomain, "SNA") == 0)
421 domain = AF_SNA;
422 break;
423 case 'U':
424 if (strcmp(sdomain, "UNIX") == 0)
425 domain = AF_UNIX;
426 break;
427 case 'X':
428 if (strcmp(sdomain, "X25") == 0)
429 domain = AF_X25;
430 break;
431 }
432 stype = RepAtom(AtomOfTerm(t2))->StrOfAE;
433 if (stype[0] != 'S' || stype[1] != 'O' || stype[2] != 'C' ||
434 stype[3] != 'K' || stype[4] != '_')
435 return (FALSE); /* Error */
436 stype += 5;
437 if (strcmp(stype, "STREAM") == 0)
438 type = SOCK_STREAM;
439 else if (strcmp(stype, "DGRAM") == 0)
440 type = SOCK_DGRAM;
441 else if (strcmp(stype, "RAW") == 0)
442 type = SOCK_RAW;
443 else if (strcmp(stype, "RDM") == 0)
444 type = SOCK_RDM;
445 else if (strcmp(stype, "SEQPACKET") == 0)
446 type = SOCK_SEQPACKET;
447 else if (strcmp(stype, "PACKET") == 0)
448 type = SOCK_PACKET;
449 else
450 return (FALSE);
451 protocol = IntOfTerm(t3);
452 if (protocol < 0)
453 return (FALSE);
454 fd = socket(domain, type, protocol);
455 if (invalid_socket_fd(fd)) {
456#if HAVE_STRERROR
457 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket/4 (socket: %s)",
458 strerror(socket_errno));
459#else
460 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket/4 (socket)");
461#endif
462 return (FALSE);
463 }
464 if (domain == AF_UNIX || domain == AF_LOCAL)
465 out = Yap_InitSocketStream(fd, new_socket, af_unix);
466 else if (domain == AF_INET)
467 out = Yap_InitSocketStream(fd, new_socket, af_inet);
468 else {
469/* ok, we currently don't support these sockets */
470#if _MSC_VER || defined(__MINGW32__)
471 _close(fd);
472#else
473 close(fd);
474#endif
475 return (FALSE);
476 }
477 if (out == TermNil)
478 return (FALSE);
479 return (Yap_unify(out, ARG4));
480}
481
482Int Yap_CloseSocket(int fd, socket_info status, socket_domain domain) {
483#if _MSC_VER || defined(__MINGW32__)
484 /* prevent further writing
485 to the socket */
486 if (status == server_session_socket || status == client_socket) {
487 char bfr;
488
489 if (shutdown(fd, 1) != 0) {
490 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)");
491 return (FALSE);
492 }
493 /* read all pending characters
494 from the socket */
495 while (recv(fd, &bfr, 1, 0) > 0)
496 ;
497 /* prevent further reading
498 from the socket */
499 if (shutdown(fd, 0) < 0) {
500 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)");
501 return (FALSE);
502 }
503
504 /* close the socket */
505 if (closesocket(fd) != 0) {
506#if HAVE_STRERROR
507 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close: %s)",
508 strerror(socket_errno));
509#else
510 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)");
511#endif
512 }
513#else
514 if (status == server_session_socket || status == client_socket) {
515 if (shutdown(fd, 2) < 0) {
516#if HAVE_STRERROR
517 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (shutdown: %s)",
518 strerror(socket_errno));
519#else
520 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (shutdown)");
521#endif
522 return (FALSE);
523 }
524 }
525 if (close(fd) != 0) {
526#if HAVE_STRERROR
527 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close: %s)",
528 strerror(socket_errno));
529#else
530 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)");
531#endif
532#endif
533 return (FALSE);
534 }
535 return (TRUE);
536}
537
538static Int p_socket_close(USES_REGS1) {
539 Term t1 = Deref(ARG1);
540 int sno;
541
542 if ((sno = Yap_CheckSocketStream(t1, "socket_close/1")) < 0) {
543 return (FALSE);
544 }
545 Yap_CloseStream(sno);
546 return (TRUE);
547}
548
549static Int p_socket_bind(USES_REGS1) {
550 Term t1 = Deref(ARG1);
551 Term t2 = Deref(ARG2);
552 int sno;
553 Functor fun;
554 socket_info status;
555 int fd;
556
557 if ((sno = Yap_CheckSocketStream(t1, "socket_bind/2")) < 0) {
558 return (FALSE);
559 }
560 status = Yap_GetSocketStatus(sno);
561 fd = Yap_GetStreamFd(sno);
562 if (status != new_socket) {
563 /* ok, this should be an error, as you are trying to bind */
564 return (FALSE);
565 }
566 if (IsVarTerm(t2)) {
567 Yap_Error(INSTANTIATION_ERROR, t2, "socket_bind/2");
568 return (FALSE);
569 }
570 if (!IsApplTerm(t2)) {
571 Yap_Error(DOMAIN_ERROR_STREAM, t2, "socket_bind/2");
572 return (FALSE);
573 }
574 fun = FunctorOfTerm(t2);
575#if HAVE_SYS_UN_H
576 if (fun == FunctorAfUnix || fun == FunctorAfLocal) {
577 struct sockaddr_un sock;
578 Term taddr = ArgOfTerm(1, t2);
579 char *s;
580 int len;
581
582 if (IsVarTerm(taddr)) {
583 Yap_Error(INSTANTIATION_ERROR, t2, "socket_bind/2");
584 return (FALSE);
585 }
586 if (!IsAtomTerm(taddr)) {
587 Yap_Error(TYPE_ERROR_ATOM, taddr, "socket_bind/2");
588 return (FALSE);
589 }
590 s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
591 sock.sun_family = AF_UNIX;
592 if ((len = strlen(s)) > 107) /* hit me with a broomstick */ {
593 Yap_Error(DOMAIN_ERROR_STREAM, taddr, "socket_bind/2");
594 return (FALSE);
595 }
596 sock.sun_family = AF_UNIX;
597 strcpy(sock.sun_path, s);
598 if (bind(fd, (struct sockaddr *)(&sock),
599 ((size_t)(((struct sockaddr_un *)0)->sun_path) + len)) < 0) {
600#if HAVE_STRERROR
601 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind: %s)",
602 strerror(socket_errno));
603#else
604 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind)");
605#endif
606 return (FALSE);
607 }
608 Yap_UpdateSocketStream(sno, server_socket, af_unix);
609 return (TRUE);
610 } else
611#endif
612 if (fun == FunctorAfInet) {
613 Term thost = ArgOfTerm(1, t2);
614 Term tport = ArgOfTerm(2, t2);
615 char *shost;
616 struct hostent *he;
617 struct sockaddr_in saddr;
618 Int port;
619
620 memset((void *)&saddr, (int)0, sizeof(saddr));
621 if (IsVarTerm(thost)) {
622 saddr.sin_addr.s_addr = INADDR_ANY;
623 } else if (!IsAtomTerm(thost)) {
624 Yap_Error(TYPE_ERROR_ATOM, thost, "socket_bind/2");
625 return (FALSE);
626 } else {
627 shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
628 if ((he = gethostbyname(shost)) == NULL) {
629#if HAVE_STRERROR
630 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
631 "socket_bind/2 (gethostbyname: %s)", strerror(socket_errno));
632#else
633 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
634 "socket_bind/2 (gethostbyname)");
635#endif
636 return (FALSE);
637 }
638 memmove((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length);
639 }
640 if (IsVarTerm(tport)) {
641 port = 0;
642 } else {
643 port = IntOfTerm(tport);
644 }
645 saddr.sin_port = htons(port);
646 saddr.sin_family = AF_INET;
647 if (bind(fd, (struct sockaddr *)&saddr, sizeof(saddr)) == -1) {
648#if HAVE_STRERROR
649 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind: %s)",
650 strerror(socket_errno));
651#else
652 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind)");
653#endif
654 return (FALSE);
655 }
656
657 if (IsVarTerm(tport)) {
658/* get the port number */
659#if _WIN32 || defined(__MINGW32__)
660 int namelen;
661#else
662 socklen_t namelen;
663#endif
664 Term t;
665 if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) {
666#if HAVE_STRERROR
667 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
668 "socket_bind/2 (getsockname: %s)", strerror(socket_errno));
669#else
670 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
671 "socket_bind/2 (getsockname)");
672#endif
673 return (FALSE);
674 }
675 t = MkIntTerm(ntohs(saddr.sin_port));
676 Yap_unify(ArgOfTermCell(2, t2), t);
677 }
678 Yap_UpdateSocketStream(sno, server_socket, af_inet);
679 return (TRUE);
680 } else
681 return (FALSE);
682}
683
684static Int p_socket_connect(USES_REGS1) {
685 Term t1 = Deref(ARG1);
686 Term t2 = Deref(ARG2);
687 Functor fun;
688 int sno;
689 socket_info status;
690 int fd;
691 int flag;
692 Term out;
693
694 if ((sno = Yap_CheckSocketStream(t1, "socket_connect/3")) < 0) {
695 return (FALSE);
696 }
697 if (IsVarTerm(t2)) {
698 Yap_Error(INSTANTIATION_ERROR, t2, "socket_connect/3");
699 return (FALSE);
700 }
701 if (!IsApplTerm(t2)) {
702 Yap_Error(DOMAIN_ERROR_STREAM, t2, "socket_connect/3");
703 return (FALSE);
704 }
705 fun = FunctorOfTerm(t2);
706 fd = Yap_GetStreamFd(sno);
707 status = Yap_GetSocketStatus(sno);
708 if (status != new_socket) {
709 /* ok, this should be an error, as you are trying to bind */
710 return (FALSE);
711 }
712#if HAVE_SYS_UN_H
713 if (fun == FunctorAfUnix) {
714 struct sockaddr_un sock;
715 Term taddr = ArgOfTerm(1, t2);
716 char *s;
717 int len;
718
719 if (IsVarTerm(taddr)) {
720 Yap_Error(INSTANTIATION_ERROR, t2, "socket_connect/3");
721 return (FALSE);
722 }
723 if (!IsAtomTerm(taddr)) {
724 Yap_Error(TYPE_ERROR_ATOM, taddr, "socket_connect/3");
725 return (FALSE);
726 }
727 s = RepAtom(AtomOfTerm(taddr))->StrOfAE;
728 sock.sun_family = AF_UNIX;
729 if ((len = strlen(s)) > 107) /* beat me with a broomstick */ {
730 Yap_Error(DOMAIN_ERROR_STREAM, taddr, "socket_connect/3");
731 return (FALSE);
732 }
733 sock.sun_family = AF_UNIX;
734 strcpy(sock.sun_path, s);
735 if ((flag = connect(
736 fd, (struct sockaddr *)(&sock),
737 ((size_t)(((struct sockaddr_un *)0)->sun_path) + len))) < 0) {
738#if HAVE_STRERROR
739 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
740 "socket_connect/3 (connect: %s)", strerror(socket_errno));
741#else
742 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect)");
743#endif
744 return (FALSE);
745 }
746 Yap_UpdateSocketStream(sno, client_socket, af_unix);
747 } else
748#endif
749 if (fun == FunctorAfInet) {
750 Term thost = ArgOfTerm(1, t2);
751 Term tport = ArgOfTerm(2, t2);
752 char *shost;
753 struct hostent *he;
754 struct sockaddr_in saddr;
755 unsigned short int port;
756
757 memset((void *)&saddr, (int)0, sizeof(saddr));
758 if (IsVarTerm(thost)) {
759 Yap_Error(INSTANTIATION_ERROR, thost, "socket_connect/3");
760 return (FALSE);
761 } else if (!IsAtomTerm(thost)) {
762 Yap_Error(TYPE_ERROR_ATOM, thost, "socket_connect/3");
763 return (FALSE);
764 } else {
765 shost = RepAtom(AtomOfTerm(thost))->StrOfAE;
766 if ((he = gethostbyname(shost)) == NULL) {
767#if HAVE_STRERROR
768 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
769 "socket_connect/3 (gethostbyname: %s)",
770 strerror(socket_errno));
771#else
772 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
773 "socket_connect/3 (gethostbyname)");
774#endif
775 return (FALSE);
776 }
777 memmove((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length);
778 }
779 if (IsVarTerm(tport)) {
780 Yap_Error(INSTANTIATION_ERROR, tport, "socket_connect/3");
781 return (FALSE);
782 } else if (!IsIntegerTerm(tport)) {
783 Yap_Error(TYPE_ERROR_INTEGER, tport, "socket_connect/3");
784 return (FALSE);
785 } else {
786 port = (unsigned short int)IntegerOfTerm(tport);
787 }
788 saddr.sin_port = htons(port);
789 saddr.sin_family = AF_INET;
790#if ENABLE_SO_LINGER
791 {
792 struct linger ling; /* For making sockets linger. */
793 /* disabled: I see why no reason why we should throw things away by
794 * default!! */
795 ling.l_onoff = 1;
796 ling.l_linger = 0;
797 if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (void *)&ling, sizeof(ling)) <
798 0) {
799#if HAVE_STRERROR
800 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
801 "socket_connect/3 (setsockopt_linger: %s)",
802 strerror(socket_errno));
803#else
804 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
805 "socket_connect/3 (setsockopt_linger)");
806#endif
807 return FALSE;
808 }
809 }
810#endif
811
812 {
813 int one = 1; /* code by David MW Powers */
814
815 if (setsockopt(fd, SOL_SOCKET, SO_BROADCAST, (void *)&one, sizeof(one))) {
816#if HAVE_STRERROR
817 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
818 "socket_connect/3 (setsockopt_broadcast: %s)",
819 strerror(socket_errno));
820#else
821 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
822 "socket_connect/3 (setsockopt_broadcast)");
823#endif
824 return FALSE;
825 }
826 }
827
828 flag = connect(fd, (struct sockaddr *)&saddr, sizeof(saddr));
829 if (flag < 0) {
830#if HAVE_STRERROR
831 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
832 "socket_connect/3 (connect: %s)", strerror(socket_errno));
833#else
834 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect)");
835#endif
836 return FALSE;
837 }
838 Yap_UpdateSocketStream(sno, client_socket, af_inet);
839 } else
840 return (FALSE);
841 out = t1;
842 return (Yap_unify(out, ARG3));
843}
844
845static Int p_socket_listen(USES_REGS1) {
846 Term t1 = Deref(ARG1);
847 Term t2 = Deref(ARG2);
848 int sno;
849 socket_info status;
850 int fd;
851 Int j;
852
853 if ((sno = Yap_CheckSocketStream(t1, "socket_listen/2")) < 0) {
854 return (FALSE);
855 }
856 if (IsVarTerm(t2)) {
857 Yap_Error(INSTANTIATION_ERROR, t2, "socket_listen/2");
858 return (FALSE);
859 }
860 if (!IsIntTerm(t2)) {
861 Yap_Error(TYPE_ERROR_INTEGER, t2, "socket_listen/2");
862 return (FALSE);
863 }
864 j = IntOfTerm(t2);
865 if (j < 0) {
866 Yap_Error(DOMAIN_ERROR_STREAM, t1, "socket_listen/2");
867 return (FALSE);
868 }
869 fd = Yap_GetStreamFd(sno);
870 status = Yap_GetSocketStatus(sno);
871 if (status != server_socket) {
872 /* ok, this should be an error, as you are trying to bind */
873 return (FALSE);
874 }
875 if (listen(fd, j) < 0) {
876#if HAVE_STRERROR
877 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_listen/2 (listen: %s)",
878 strerror(socket_errno));
879#else
880 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_listen/2 (listen)");
881#endif
882 }
883 return (TRUE);
884}
885
886static Int p_socket_accept(USES_REGS1) {
887 Term t1 = Deref(ARG1);
888 int sno;
889 socket_info status;
890 socket_domain domain;
891 int ofd, fd;
892 Term out;
893
894 if ((sno = Yap_CheckSocketStream(t1, "socket_accept/3")) < 0) {
895 return (FALSE);
896 }
897 ofd = Yap_GetStreamFd(sno);
898 status = Yap_GetSocketStatus(sno);
899 if (status != server_socket) {
900 /* ok, this should be an error, as you are trying to bind */
901 return (FALSE);
902 }
903 domain = Yap_GetSocketDomain(sno);
904#if HAVE_SYS_UN_H
905 if (domain == af_unix) {
906 struct sockaddr_un caddr;
907 socklen_t len;
908
909 memset((void *)&caddr, (int)0, sizeof(caddr));
910 if ((fd = accept(ofd, (struct sockaddr *)&caddr, &len)) < 0) {
911#if HAVE_STRERROR
912 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept: %s)",
913 strerror(socket_errno));
914#else
915 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept)");
916#endif
917 }
918 /* ignore 2nd argument */
919 out = Yap_InitSocketStream(fd, server_session_socket, af_unix);
920 } else
921#endif
922 if (domain == af_inet) {
923 struct sockaddr_in caddr;
924 Term tcli;
925 char *s;
926 socklen_t len;
927
928 len = sizeof(caddr);
929 memset((void *)&caddr, (int)0, sizeof(caddr));
930 if (invalid_socket_fd(fd = accept(ofd, (struct sockaddr *)&caddr, &len))) {
931#if HAVE_STRERROR
932 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept: %s)",
933 strerror(socket_errno));
934#else
935 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept)");
936#endif
937 return (FALSE);
938 }
939 if ((s = inet_ntoa(caddr.sin_addr)) == NULL) {
940#if HAVE_STRERROR
941 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
942 "socket_accept/3 (inet_ntoa: %s)", strerror(socket_errno));
943#else
944 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (inet_ntoa)");
945#endif
946 }
947 tcli = MkAtomTerm(Yap_LookupAtom(s));
948 if (!Yap_unify(ARG2, tcli))
949 return (FALSE);
950 out = Yap_InitSocketStream(fd, server_session_socket, af_inet);
951 } else
952 return (FALSE);
953 if (out == TermNil)
954 return (FALSE);
955 return (Yap_unify(out, ARG3));
956}
957
958static Int p_socket_buffering(USES_REGS1) {
959 Term t1 = Deref(ARG1);
960 Term t2 = Deref(ARG2);
961 Term t4 = Deref(ARG4);
962 Atom mode;
963 int fd;
964 int writing;
965#if _WIN32 || defined(__MINGW32__)
966 int bufsize;
967#else
968 unsigned int bufsize;
969#endif
970 int sno;
971 socklen_t len;
972
973 if ((sno = Yap_CheckSocketStream(t1, "socket_buffering/4")) < 0) {
974 return (FALSE);
975 }
976 if (IsVarTerm(t2)) {
977 Yap_Error(INSTANTIATION_ERROR, t2, "socket_buffering/4");
978 return (FALSE);
979 }
980 if (!IsAtomTerm(t2)) {
981 Yap_Error(TYPE_ERROR_ATOM, t2, "socket_buffering/4");
982 return (FALSE);
983 }
984 mode = AtomOfTerm(t2);
985 if (mode == AtomRead)
986 writing = FALSE;
987 else if (mode == AtomWrite)
988 writing = TRUE;
989 else {
990 Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "socket_buffering/4");
991 return (FALSE);
992 }
993 fd = Yap_GetStreamFd(sno);
994 if (writing) {
995 getsockopt(fd, SOL_SOCKET, SO_SNDBUF, (void *)&bufsize, &len);
996 } else {
997 getsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, &len);
998 }
999 if (!Yap_unify(ARG3, MkIntegerTerm(bufsize)))
1000 return (FALSE);
1001 if (IsVarTerm(t4)) {
1002 bufsize = BUFSIZ;
1003 } else {
1004 Int siz;
1005 if (!IsIntegerTerm(t4)) {
1006 Yap_Error(TYPE_ERROR_INTEGER, t4, "socket_buffering/4");
1007 return (FALSE);
1008 }
1009 siz = IntegerOfTerm(t4);
1010 if (siz < 0) {
1011 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t4, "socket_buffering/4");
1012 return (FALSE);
1013 }
1014 bufsize = siz;
1015 }
1016 if (writing) {
1017 setsockopt(fd, SOL_SOCKET, SO_SNDBUF, (void *)&bufsize, sizeof(bufsize));
1018 } else {
1019 setsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, sizeof(bufsize));
1020 }
1021 return (TRUE);
1022}
1023
1024static Term select_out_list(Term t1, fd_set *readfds_ptr USES_REGS) {
1025 if (t1 == TermNil) {
1026 return (TermNil);
1027 } else {
1028 int fd;
1029 int sno;
1030 Term next = select_out_list(TailOfTerm(t1), readfds_ptr PASS_REGS);
1031 Term Head = HeadOfTerm(t1);
1032
1033 sno = Yap_CheckIOStream(Head, "stream_select/5");
1034 fd = Yap_GetStreamFd(sno);
1035 if (FD_ISSET(fd, readfds_ptr))
1036 return (MkPairTerm(Head, next));
1037 else
1038 return (MkPairTerm(TermNil, next));
1039 }
1040}
1041
1042static Int p_socket_select(USES_REGS1) {
1043 Term t1 = Deref(ARG1);
1044 Term t2 = Deref(ARG2);
1045 Term t3 = Deref(ARG3);
1046 fd_set readfds, writefds, exceptfds;
1047 struct timeval timeout, *ptime;
1048
1049#if _MSC_VER || defined(__MINGW32__)
1050 u_int fdmax = 0;
1051#else
1052 int fdmax = 0;
1053#endif
1054 Int tsec, tusec;
1055 Term tout = TermNil, ti, Head;
1056
1057 if (IsVarTerm(t1)) {
1058 Yap_Error(INSTANTIATION_ERROR, t1, "socket_select/5");
1059 return (FALSE);
1060 }
1061 if (!IsPairTerm(t1)) {
1062 Yap_Error(TYPE_ERROR_LIST, t1, "socket_select/5");
1063 return (FALSE);
1064 }
1065 if (IsVarTerm(t2)) {
1066 Yap_Error(INSTANTIATION_ERROR, t2, "socket_select/5");
1067 return (FALSE);
1068 }
1069 if (!IsIntegerTerm(t2)) {
1070 Yap_Error(TYPE_ERROR_INTEGER, t2, "socket_select/5");
1071 return (FALSE);
1072 }
1073 if (IsVarTerm(t3)) {
1074 Yap_Error(INSTANTIATION_ERROR, t3, "socket_select/5");
1075 return (FALSE);
1076 }
1077 if (!IsIntegerTerm(t3)) {
1078 Yap_Error(TYPE_ERROR_INTEGER, t3, "socket_select/5");
1079 return (FALSE);
1080 }
1081 FD_ZERO(&readfds);
1082 FD_ZERO(&writefds);
1083 FD_ZERO(&exceptfds);
1084 /* fetch the input streams */
1085 ti = t1;
1086 while (ti != TermNil) {
1087#if _MSC_VER || defined(__MINGW32__)
1088 u_int fd;
1089#else
1090 int fd;
1091#endif
1092 int sno;
1093
1094 Head = HeadOfTerm(ti);
1095 sno = Yap_CheckIOStream(Head, "stream_select/5");
1096 if (sno < 0)
1097 return (FALSE);
1098 fd = Yap_GetStreamFd(sno);
1099 FD_SET(fd, &readfds);
1100 if (fd > fdmax)
1101 fdmax = fd;
1102 ti = TailOfTerm(ti);
1103 }
1104 /* now, check the time */
1105 tsec = IntegerOfTerm(t2);
1106 tusec = IntegerOfTerm(t3);
1107 if (tsec < 0) /* off */ {
1108 ptime = NULL;
1109 } else {
1110 timeout.tv_sec = tsec;
1111 timeout.tv_usec = tusec;
1112 ptime = &timeout;
1113 }
1114 /* do the real work */
1115 if (select(fdmax + 1, &readfds, &writefds, &exceptfds, ptime) < 0) {
1116#if HAVE_STRERROR
1117 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_select/5 (select: %s)",
1118 strerror(socket_errno));
1119#else
1120 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_select/5 (select)");
1121#endif
1122 }
1123 tout = select_out_list(t1, &readfds PASS_REGS);
1124 /* we're done, just pass the info back */
1125 return (Yap_unify(ARG4, tout));
1126}
1127
1128static Int p_current_host(USES_REGS1) {
1129 char oname[MAXHOSTNAMELEN], *name;
1130 Term t1 = Deref(ARG1), out;
1131
1132 if (!IsVarTerm(t1) && !IsAtomTerm(t1)) {
1133 Yap_Error(TYPE_ERROR_ATOM, t1, "current_host/2");
1134 return (FALSE);
1135 }
1136 name = oname;
1137 if (gethostname(name, sizeof(oname)) < 0) {
1138#if HAVE_STRERROR
1139 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1140 "current_host/2 (gethostname: %s)", strerror(socket_errno));
1141#else
1142 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "current_host/2 (gethostname)");
1143#endif
1144 return (FALSE);
1145 }
1146 if ((strrchr(name, '.') == NULL)) {
1147 struct hostent *he;
1148
1149 /* not a fully qualified name, ask the name server */
1150 if ((he = gethostbyname(name)) == NULL) {
1151#if HAVE_STRERROR
1152 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1153 "current_host/2 (gethostbyname: %s)", strerror(socket_errno));
1154#else
1155 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1156 "current_host/2 (gethostbyname)");
1157#endif
1158 return (FALSE);
1159 }
1160 name = (char *)(he->h_name);
1161 }
1162 if (IsAtomTerm(t1)) {
1163 char *sin = RepAtom(AtomOfTerm(t1))->StrOfAE;
1164 int faq = (strrchr(sin, '.') != NULL);
1165
1166 if (faq)
1167#if _MSC_VER || defined(__MINGW32__)
1168 return (_stricmp(name, sin) == 0);
1169#else
1170 return (strcasecmp(name, sin) == 0);
1171#endif
1172 else {
1173 int isize = strlen(sin);
1174 if (isize >= 256) {
1175 Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1,
1176 "current_host/2 (input longer than longest FAQ host name)");
1177 return (FALSE);
1178 }
1179 if (name[isize] != '.')
1180 return (FALSE);
1181 name[isize] = '\0';
1182#if _MSC_VER || defined(__MINGW32__)
1183 return (_stricmp(name, sin) == 0);
1184#else
1185 return (strcasecmp(name, sin) == 0);
1186#endif
1187 }
1188 } else {
1189 out = MkAtomTerm(Yap_LookupAtom(name));
1190 return (Yap_unify(ARG1, out));
1191 }
1192}
1193
1194static Int p_hostname_address(USES_REGS1) {
1195 char *s;
1196 Term t1 = Deref(ARG1);
1197 Term t2 = Deref(ARG2);
1198 Term tin, out;
1199 struct hostent *he;
1200
1201 if (!IsVarTerm(t1)) {
1202 if (!IsAtomTerm(t1)) {
1203 Yap_Error(TYPE_ERROR_ATOM, t1, "hostname_address/2");
1204 return (FALSE);
1205 } else
1206 tin = t1;
1207 } else if (IsVarTerm(t2)) {
1208 Yap_Error(INSTANTIATION_ERROR, t1, "hostname_address/5");
1209 return (FALSE);
1210 } else if (!IsAtomTerm(t2)) {
1211 Yap_Error(TYPE_ERROR_ATOM, t2, "hostname_address/2");
1212 return (FALSE);
1213 } else
1214 tin = t2;
1215 s = RepAtom(AtomOfTerm(tin))->StrOfAE;
1216 if (IsVarTerm(t1)) {
1217 if ((he = gethostbyaddr(s, strlen(s), AF_INET)) == NULL) {
1218#if HAVE_STRERROR
1219 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1220 "hostname_address/2 (gethostbyname: %s)",
1221 strerror(socket_errno));
1222#else
1223 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1224 "hostname_address/2 (gethostbyname)");
1225#endif
1226 }
1227 out = MkAtomTerm(Yap_LookupAtom((char *)(he->h_name)));
1228 return (Yap_unify(out, ARG1));
1229 } else {
1230 struct in_addr adr;
1231 if ((he = gethostbyname(s)) == NULL) {
1232#if HAVE_STRERROR
1233 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1234 "hostname_address/2 (gethostbyname: %s)",
1235 strerror(socket_errno));
1236#else
1237 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1238 "hostname_address/2 (gethostbyname)");
1239#endif
1240 return false;
1241 }
1242 memmove((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length);
1243 out = MkAtomTerm(Yap_LookupAtom(inet_ntoa(adr)));
1244 return (Yap_unify(out, ARG2));
1245 }
1246}
1247#endif
1248
1249void Yap_InitSocketLayer(void) {
1250#ifdef HAVE_SOCKET
1251 Yap_InitCPred("socket", 4, p_socket, SafePredFlag | SyncPredFlag);
1252 Yap_InitCPred("socket_close", 1, p_socket_close, SafePredFlag | SyncPredFlag);
1253 Yap_InitCPred("socket_bind", 2, p_socket_bind, SafePredFlag | SyncPredFlag);
1254 Yap_InitCPred("socket_connect", 3, p_socket_connect,
1255 SafePredFlag | SyncPredFlag);
1256 Yap_InitCPred("socket_listen", 2, p_socket_listen,
1257 SafePredFlag | SyncPredFlag);
1258 Yap_InitCPred("socket_accept", 3, p_socket_accept,
1259 SafePredFlag | SyncPredFlag);
1260 Yap_InitCPred("$socket_buffering", 4, p_socket_buffering,
1261 SafePredFlag | SyncPredFlag | HiddenPredFlag);
1262 Yap_InitCPred("$socket_select", 4, p_socket_select,
1263 SafePredFlag | SyncPredFlag | HiddenPredFlag);
1264 Yap_InitCPred("current_host", 1, p_current_host, SafePredFlag);
1265 Yap_InitCPred("hostname_address", 2, p_hostname_address, SafePredFlag);
1266#if _MSC_VER || defined(__MINGW32__)
1267 {
1268 WSADATA info;
1269 if (WSAStartup(MAKEWORD(2, 1), &info) != 0)
1270 exit(1);
1271 }
1272#endif
1273#endif
1274}