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