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