/************************************************************************* * * * YAP Prolog %W% %G% * * * Yap Prolog was developed at NCCUP - Universidade do Porto * * * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * * ************************************************************************** * * * File: io.h * * Last rev: 19/2/88 * * mods: * * comments: control YAP from sockets. * * * *************************************************************************/ #include "sysbits.h" #if HAVE_SOCKET #if HAVE_UNISTD_H && !defined(__MINGW32__) && !_MSC_VER #include #endif #if STDC_HEADERS #include #endif #if HAVE_SYS_TYPES_H #include #endif #if HAVE_SYS_TIME_H && !defined(__MINGW32__) && !_MSC_VER #include #endif #ifdef _WIN32 #if HAVE_IO_H #include #endif #endif #if _MSC_VER || defined(__MINGW32__) #include #include #else #if HAVE_SYS_SOCKET_H #include #endif #if HAVE_SYS_UN_H #include #endif #if HAVE_NETDB_H #include #endif #if HAVE_NETINET_IN_H #include #endif #if HAVE_ARPA_INET_H #include #endif #if HAVE_FCNTL_H #include #endif #if HAVE_STRING_H #include #endif #if HAVE_SYS_SELECT_H #include #endif #if HAVE_SYS_PARAM_H #include #endif #endif /* make sure we can compile in any platform */ #ifndef AF_UNSPEC #define AF_UNSPEC 0 #endif #ifndef AF_LOCAL #define AF_LOCAL AF_UNSPEC #endif #ifndef AF_AAL5 #define AF_AAL5 AF_UNSPEC #endif #ifndef AF_APPLETALK #define AF_APPLETALK AF_UNSPEC #endif #ifndef AF_AX25 #define AF_AX25 AF_UNSPEC #endif #ifndef AF_BRIDGE #define AF_BRIDGE AF_UNSPEC #endif #ifndef AF_DECnet #define AF_DECnet AF_UNSPEC #endif #ifndef AF_FILE #define AF_FILE AF_UNSPEC #endif #ifndef AF_INET #define AF_INET AF_UNSPEC #endif #ifndef AF_INET6 #define AF_INET6 AF_UNSPEC #endif #ifndef AF_IPX #define AF_IPX AF_UNSPEC #endif #ifndef AF_LOCAL #define AF_LOCAL AF_UNSPEC #endif #ifndef AF_NETBEUI #define AF_NETBEUI AF_UNSPEC #endif #ifndef AF_NETLINK #define AF_NETLINK AF_UNSPEC #endif #ifndef AF_NETROM #define AF_NETROM AF_UNSPEC #endif #ifndef AF_OSINET #define AF_OSINET AF_UNSPEC #endif #ifndef AF_PACKET #define AF_PACKET AF_UNSPEC #endif #ifndef AF_ROSE #define AF_ROSE AF_UNSPEC #endif #ifndef AF_ROUTE #define AF_ROUTE AF_UNSPEC #endif #ifndef AF_SECURITY #define AF_SECURITY AF_UNSPEC #endif #ifndef AF_SNA #define AF_SNA AF_UNSPEC #endif #ifndef AF_UNIX #define AF_UNIX AF_UNSPEC #endif #ifndef AF_X25 #define AF_X25 AF_UNSPEC #endif #ifndef SOCK_STREAM #define SOCK_STREAM -1 #endif #ifndef SOCK_DGRAM #define SOCK_DGRAM -1 #endif #ifndef SOCK_RAW #define SOCK_RAW -1 #endif #ifndef SOCK_RDM #define SOCK_RDM -1 #endif #ifndef SOCK_SEQPACKET #define SOCK_SEQPACKET -1 #endif #ifndef SOCK_PACKET #define SOCK_PACKET -1 #endif #ifndef MAXHOSTNAMELEN #define MAXHOSTNAMELEN 256 #endif #ifndef BUFSIZ #define BUFSIZ 256 #endif #if _MSC_VER || defined(__MINGW32__) #define socket_errno WSAGetLastError() #define invalid_socket_fd(fd) (fd) == INVALID_SOCKET #else #define socket_errno errno #define invalid_socket_fd(fd) (fd) < 0 #endif void Yap_init_socks(char *host, long interface_port) { int s; int r; struct sockaddr_in soadr; struct in_addr adr; struct hostent *he; #if HAVE_SOCKET he = gethostbyname(host); if (he == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "can not get address for host %s: %s", host, strerror(h_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "can not get address for host"); #endif return; } (void)memset((void *)&soadr, '\0', sizeof(struct sockaddr_in)); soadr.sin_family = AF_INET; soadr.sin_port = htons((short)interface_port); if (he != NULL) { memcpy((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length); } else { adr.s_addr = inet_addr(host); } soadr.sin_addr.s_addr = adr.s_addr; s = socket(AF_INET, SOCK_STREAM, 0); if (s < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket: %s", strerror(errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket"); #endif return; } #if ENABLE_SO_LINGER struct linger ling; /* disables socket lingering. */ ling.l_onoff = 1; ling.l_linger = 0; if (setsockopt(s, SOL_SOCKET, SO_LINGER, (void *)&ling, sizeof(ling)) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (setsockopt_linger)"); #endif return; } #endif r = connect(s, (struct sockaddr *)&soadr, sizeof(soadr)); if (r < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "connect failed, could not connect to interface: %s", strerror(errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "connect failed, could not connect to interface"); #endif return; } /* now reopen stdin stdout and stderr */ #if HAVE_DUP2 && !defined(__MINGW32__) if (dup2(s, 0) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin: %s", strerror(errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin"); #endif return; } if (dup2(s, 1) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout: %s", strerror(errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout"); #endif return; } if (dup2(s, 2) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr: %s", strerror(errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr"); #endif return; } #elif _MSC_VER || defined(__MINGW32__) if (_dup2(s, 0) < 0) { fprintf(stderr, "could not dup2 stdin\n"); return; } if (_dup2(s, 1) < 0) { fprintf(stderr, "could not dup2 stdout\n"); return; } if (_dup2(s, 2) < 0) { fprintf(stderr, "could not dup2 stderr\n"); return; } #else if (dup2(s, 0) < 0) { fprintf(stderr, "could not dup2 stdin\n"); return; } yp_iob[0].cnt = 0; yp_iob[0].flags = _YP_IO_SOCK | _YP_IO_READ; if (dup2(s, 1) < 0) { fprintf(stderr, "could not dup2 stdout\n"); return; } yp_iob[1].cnt = 0; yp_iob[1].flags = _YP_IO_SOCK | _YP_IO_WRITE; if (dup2(s, 2) < 0) { fprintf(stderr, "could not dup2 stderr\n"); return; } yp_iob[2].cnt = 0; yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE; #endif // Yap_sockets_io = 1; #if _MSC_VER || defined(__MINGW32__) _close(s); #else close(s); #endif #else /* HAVE_SOCKET */ Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sockets not installed", strerror(errno)); #endif /* HAVE_SOCKET */ } static Int p_socket(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term t3 = Deref(ARG3); char *sdomain, *stype; Int domain = AF_UNSPEC, type, protocol; int fd; Term out; if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "socket/4"); return (FALSE); } if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "socket/4"); return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket/4"); return (FALSE); } if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "socket/4"); return (FALSE); } if (IsVarTerm(t3)) { Yap_Error(INSTANTIATION_ERROR, t3, "socket/4"); return (FALSE); } if (!IsIntTerm(t3)) { Yap_Error(TYPE_ERROR_ATOM, t3, "socket/4"); return (FALSE); } sdomain = RepAtom(AtomOfTerm(t1))->StrOfAE; if (sdomain[0] != 'A' || sdomain[1] != 'F' || sdomain[2] != '_') return (FALSE); /* Error */ sdomain += 3; switch (sdomain[0]) { case 'A': if (strcmp(sdomain, "AAL5") == 0) domain = AF_AAL5; else if (strcmp(sdomain, "APPLETALK") == 0) domain = AF_APPLETALK; else if (strcmp(sdomain, "AX25") == 0) domain = AF_AX25; break; case 'B': if (strcmp(sdomain, "BRIDGE") == 0) domain = AF_APPLETALK; break; case 'D': if (strcmp(sdomain, "DECnet") == 0) domain = AF_DECnet; break; case 'F': if (strcmp(sdomain, "FILE") == 0) domain = AF_FILE; break; case 'I': if (strcmp(sdomain, "INET") == 0) domain = AF_INET; else if (strcmp(sdomain, "INET6") == 0) domain = AF_INET6; else if (strcmp(sdomain, "IPX") == 0) domain = AF_IPX; break; case 'L': if (strcmp(sdomain, "LOCAL") == 0) domain = AF_LOCAL; break; case 'N': if (strcmp(sdomain, "NETBEUI") == 0) domain = AF_NETBEUI; else if (strcmp(sdomain, "NETLINK") == 0) domain = AF_NETLINK; else if (strcmp(sdomain, "NETROM") == 0) domain = AF_NETROM; break; case 'O': if (strcmp(sdomain, "OSINET") == 0) domain = AF_OSINET; break; case 'P': if (strcmp(sdomain, "PACKET") == 0) domain = AF_PACKET; break; case 'R': if (strcmp(sdomain, "ROSE") == 0) domain = AF_ROSE; else if (strcmp(sdomain, "ROUTE") == 0) domain = AF_ROUTE; break; case 'S': if (strcmp(sdomain, "SECURITY") == 0) domain = AF_SECURITY; else if (strcmp(sdomain, "SNA") == 0) domain = AF_SNA; break; case 'U': if (strcmp(sdomain, "UNIX") == 0) domain = AF_UNIX; break; case 'X': if (strcmp(sdomain, "X25") == 0) domain = AF_X25; break; } stype = RepAtom(AtomOfTerm(t2))->StrOfAE; if (stype[0] != 'S' || stype[1] != 'O' || stype[2] != 'C' || stype[3] != 'K' || stype[4] != '_') return (FALSE); /* Error */ stype += 5; if (strcmp(stype, "STREAM") == 0) type = SOCK_STREAM; else if (strcmp(stype, "DGRAM") == 0) type = SOCK_DGRAM; else if (strcmp(stype, "RAW") == 0) type = SOCK_RAW; else if (strcmp(stype, "RDM") == 0) type = SOCK_RDM; else if (strcmp(stype, "SEQPACKET") == 0) type = SOCK_SEQPACKET; else if (strcmp(stype, "PACKET") == 0) type = SOCK_PACKET; else return (FALSE); protocol = IntOfTerm(t3); if (protocol < 0) return (FALSE); fd = socket(domain, type, protocol); if (invalid_socket_fd(fd)) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket/4 (socket: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket/4 (socket)"); #endif return (FALSE); } if (domain == AF_UNIX || domain == AF_LOCAL) out = Yap_InitSocketStream(fd, new_socket, af_unix); else if (domain == AF_INET) out = Yap_InitSocketStream(fd, new_socket, af_inet); else { /* ok, we currently don't support these sockets */ #if _MSC_VER || defined(__MINGW32__) _close(fd); #else close(fd); #endif return (FALSE); } if (out == TermNil) return (FALSE); return (Yap_unify(out, ARG4)); } Int Yap_CloseSocket(int fd, socket_info status, socket_domain domain) { #if _MSC_VER || defined(__MINGW32__) /* prevent further writing to the socket */ if (status == server_session_socket || status == client_socket) { char bfr; if (shutdown(fd, 1) != 0) { Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); return (FALSE); } /* read all pending characters from the socket */ while (recv(fd, &bfr, 1, 0) > 0) ; /* prevent further reading from the socket */ if (shutdown(fd, 0) < 0) { Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); return (FALSE); } /* close the socket */ if (closesocket(fd) != 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); #endif } #else if (status == server_session_socket || status == client_socket) { if (shutdown(fd, 2) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (shutdown: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (shutdown)"); #endif return (FALSE); } } if (close(fd) != 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); #endif #endif return (FALSE); } return (TRUE); } static Int p_socket_close(USES_REGS1) { Term t1 = Deref(ARG1); int sno; if ((sno = Yap_CheckSocketStream(t1, "socket_close/1")) < 0) { return (FALSE); } Yap_CloseStream(sno); return (TRUE); } static Int p_socket_bind(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); int sno; Functor fun; socket_info status; int fd; if ((sno = Yap_CheckSocketStream(t1, "socket_bind/2")) < 0) { return (FALSE); } status = Yap_GetSocketStatus(sno); fd = Yap_GetStreamFd(sno); if (status != new_socket) { /* ok, this should be an error, as you are trying to bind */ return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_bind/2"); return (FALSE); } if (!IsApplTerm(t2)) { Yap_Error(DOMAIN_ERROR_STREAM, t2, "socket_bind/2"); return (FALSE); } fun = FunctorOfTerm(t2); #if HAVE_SYS_UN_H if (fun == FunctorAfUnix || fun == FunctorAfLocal) { struct sockaddr_un sock; Term taddr = ArgOfTerm(1, t2); char *s; int len; if (IsVarTerm(taddr)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_bind/2"); return (FALSE); } if (!IsAtomTerm(taddr)) { Yap_Error(TYPE_ERROR_ATOM, taddr, "socket_bind/2"); return (FALSE); } s = RepAtom(AtomOfTerm(taddr))->StrOfAE; sock.sun_family = AF_UNIX; if ((len = strlen(s)) > 107) /* hit me with a broomstick */ { Yap_Error(DOMAIN_ERROR_STREAM, taddr, "socket_bind/2"); return (FALSE); } sock.sun_family = AF_UNIX; strcpy(sock.sun_path, s); if (bind(fd, (struct sockaddr *)(&sock), ((size_t)(((struct sockaddr_un *)0)->sun_path) + len)) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind)"); #endif return (FALSE); } Yap_UpdateSocketStream(sno, server_socket, af_unix); return (TRUE); } else #endif if (fun == FunctorAfInet) { Term thost = ArgOfTerm(1, t2); Term tport = ArgOfTerm(2, t2); char *shost; struct hostent *he; struct sockaddr_in saddr; Int port; memset((void *)&saddr, (int)0, sizeof(saddr)); if (IsVarTerm(thost)) { saddr.sin_addr.s_addr = INADDR_ANY; } else if (!IsAtomTerm(thost)) { Yap_Error(TYPE_ERROR_ATOM, thost, "socket_bind/2"); return (FALSE); } else { shost = RepAtom(AtomOfTerm(thost))->StrOfAE; if ((he = gethostbyname(shost)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (gethostbyname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (gethostbyname)"); #endif return (FALSE); } memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length); } if (IsVarTerm(tport)) { port = 0; } else { port = IntOfTerm(tport); } saddr.sin_port = htons(port); saddr.sin_family = AF_INET; if (bind(fd, (struct sockaddr *)&saddr, sizeof(saddr)) == -1) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind)"); #endif return (FALSE); } if (IsVarTerm(tport)) { /* get the port number */ #if _WIN32 || defined(__MINGW32__) int namelen; #else socklen_t namelen; #endif Term t; if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (getsockname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (getsockname)"); #endif return (FALSE); } t = MkIntTerm(ntohs(saddr.sin_port)); Yap_unify(ArgOfTermCell(2, t2), t); } Yap_UpdateSocketStream(sno, server_socket, af_inet); return (TRUE); } else return (FALSE); } static Int p_socket_connect(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Functor fun; int sno; socket_info status; int fd; int flag; Term out; if ((sno = Yap_CheckSocketStream(t1, "socket_connect/3")) < 0) { return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_connect/3"); return (FALSE); } if (!IsApplTerm(t2)) { Yap_Error(DOMAIN_ERROR_STREAM, t2, "socket_connect/3"); return (FALSE); } fun = FunctorOfTerm(t2); fd = Yap_GetStreamFd(sno); status = Yap_GetSocketStatus(sno); if (status != new_socket) { /* ok, this should be an error, as you are trying to bind */ return (FALSE); } #if HAVE_SYS_UN_H if (fun == FunctorAfUnix) { struct sockaddr_un sock; Term taddr = ArgOfTerm(1, t2); char *s; int len; if (IsVarTerm(taddr)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_connect/3"); return (FALSE); } if (!IsAtomTerm(taddr)) { Yap_Error(TYPE_ERROR_ATOM, taddr, "socket_connect/3"); return (FALSE); } s = RepAtom(AtomOfTerm(taddr))->StrOfAE; sock.sun_family = AF_UNIX; if ((len = strlen(s)) > 107) /* beat me with a broomstick */ { Yap_Error(DOMAIN_ERROR_STREAM, taddr, "socket_connect/3"); return (FALSE); } sock.sun_family = AF_UNIX; strcpy(sock.sun_path, s); if ((flag = connect( fd, (struct sockaddr *)(&sock), ((size_t)(((struct sockaddr_un *)0)->sun_path) + len))) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect)"); #endif return (FALSE); } Yap_UpdateSocketStream(sno, client_socket, af_unix); } else #endif if (fun == FunctorAfInet) { Term thost = ArgOfTerm(1, t2); Term tport = ArgOfTerm(2, t2); char *shost; struct hostent *he; struct sockaddr_in saddr; unsigned short int port; memset((void *)&saddr, (int)0, sizeof(saddr)); if (IsVarTerm(thost)) { Yap_Error(INSTANTIATION_ERROR, thost, "socket_connect/3"); return (FALSE); } else if (!IsAtomTerm(thost)) { Yap_Error(TYPE_ERROR_ATOM, thost, "socket_connect/3"); return (FALSE); } else { shost = RepAtom(AtomOfTerm(thost))->StrOfAE; if ((he = gethostbyname(shost)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (gethostbyname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (gethostbyname)"); #endif return (FALSE); } memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length); } if (IsVarTerm(tport)) { Yap_Error(INSTANTIATION_ERROR, tport, "socket_connect/3"); return (FALSE); } else if (!IsIntegerTerm(tport)) { Yap_Error(TYPE_ERROR_INTEGER, tport, "socket_connect/3"); return (FALSE); } else { port = (unsigned short int)IntegerOfTerm(tport); } saddr.sin_port = htons(port); saddr.sin_family = AF_INET; #if ENABLE_SO_LINGER { struct linger ling; /* For making sockets linger. */ /* disabled: I see why no reason why we should throw things away by * default!! */ ling.l_onoff = 1; ling.l_linger = 0; if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (void *)&ling, sizeof(ling)) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (setsockopt_linger)"); #endif return FALSE; } } #endif { int one = 1; /* code by David MW Powers */ if (setsockopt(fd, SOL_SOCKET, SO_BROADCAST, (void *)&one, sizeof(one))) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (setsockopt_broadcast: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (setsockopt_broadcast)"); #endif return FALSE; } } flag = connect(fd, (struct sockaddr *)&saddr, sizeof(saddr)); if (flag < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect)"); #endif return FALSE; } Yap_UpdateSocketStream(sno, client_socket, af_inet); } else return (FALSE); out = t1; return (Yap_unify(out, ARG3)); } static Int p_socket_listen(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); int sno; socket_info status; int fd; Int j; if ((sno = Yap_CheckSocketStream(t1, "socket_listen/2")) < 0) { return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_listen/2"); return (FALSE); } if (!IsIntTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "socket_listen/2"); return (FALSE); } j = IntOfTerm(t2); if (j < 0) { Yap_Error(DOMAIN_ERROR_STREAM, t1, "socket_listen/2"); return (FALSE); } fd = Yap_GetStreamFd(sno); status = Yap_GetSocketStatus(sno); if (status != server_socket) { /* ok, this should be an error, as you are trying to bind */ return (FALSE); } if (listen(fd, j) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_listen/2 (listen: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_listen/2 (listen)"); #endif } return (TRUE); } static Int p_socket_accept(USES_REGS1) { Term t1 = Deref(ARG1); int sno; socket_info status; socket_domain domain; int ofd, fd; Term out; if ((sno = Yap_CheckSocketStream(t1, "socket_accept/3")) < 0) { return (FALSE); } ofd = Yap_GetStreamFd(sno); status = Yap_GetSocketStatus(sno); if (status != server_socket) { /* ok, this should be an error, as you are trying to bind */ return (FALSE); } domain = Yap_GetSocketDomain(sno); #if HAVE_SYS_UN_H if (domain == af_unix) { struct sockaddr_un caddr; socklen_t len; memset((void *)&caddr, (int)0, sizeof(caddr)); if ((fd = accept(ofd, (struct sockaddr *)&caddr, &len)) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept)"); #endif } /* ignore 2nd argument */ out = Yap_InitSocketStream(fd, server_session_socket, af_unix); } else #endif if (domain == af_inet) { struct sockaddr_in caddr; Term tcli; char *s; socklen_t len; len = sizeof(caddr); memset((void *)&caddr, (int)0, sizeof(caddr)); if (invalid_socket_fd(fd = accept(ofd, (struct sockaddr *)&caddr, &len))) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept)"); #endif return (FALSE); } if ((s = inet_ntoa(caddr.sin_addr)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (inet_ntoa: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (inet_ntoa)"); #endif } tcli = MkAtomTerm(Yap_LookupAtom(s)); if (!Yap_unify(ARG2, tcli)) return (FALSE); out = Yap_InitSocketStream(fd, server_session_socket, af_inet); } else return (FALSE); if (out == TermNil) return (FALSE); return (Yap_unify(out, ARG3)); } static Int p_socket_buffering(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term t4 = Deref(ARG4); Atom mode; int fd; int writing; #if _WIN32 || defined(__MINGW32__) int bufsize; #else unsigned int bufsize; #endif int sno; socklen_t len; if ((sno = Yap_CheckSocketStream(t1, "socket_buffering/4")) < 0) { return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_buffering/4"); return (FALSE); } if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "socket_buffering/4"); return (FALSE); } mode = AtomOfTerm(t2); if (mode == AtomRead) writing = FALSE; else if (mode == AtomWrite) writing = TRUE; else { Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "socket_buffering/4"); return (FALSE); } fd = Yap_GetStreamFd(sno); if (writing) { getsockopt(fd, SOL_SOCKET, SO_SNDBUF, (void *)&bufsize, &len); } else { getsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, &len); } if (!Yap_unify(ARG3, MkIntegerTerm(bufsize))) return (FALSE); if (IsVarTerm(t4)) { bufsize = BUFSIZ; } else { Int siz; if (!IsIntegerTerm(t4)) { Yap_Error(TYPE_ERROR_INTEGER, t4, "socket_buffering/4"); return (FALSE); } siz = IntegerOfTerm(t4); if (siz < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t4, "socket_buffering/4"); return (FALSE); } bufsize = siz; } if (writing) { setsockopt(fd, SOL_SOCKET, SO_SNDBUF, (void *)&bufsize, sizeof(bufsize)); } else { setsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, sizeof(bufsize)); } return (TRUE); } static Term select_out_list(Term t1, fd_set *readfds_ptr USES_REGS) { if (t1 == TermNil) { return (TermNil); } else { int fd; int sno; Term next = select_out_list(TailOfTerm(t1), readfds_ptr PASS_REGS); Term Head = HeadOfTerm(t1); sno = Yap_CheckIOStream(Head, "stream_select/5"); fd = Yap_GetStreamFd(sno); if (FD_ISSET(fd, readfds_ptr)) return (MkPairTerm(Head, next)); else return (MkPairTerm(TermNil, next)); } } static Int p_socket_select(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term t3 = Deref(ARG3); fd_set readfds, writefds, exceptfds; struct timeval timeout, *ptime; #if _MSC_VER || defined(__MINGW32__) u_int fdmax = 0; #else int fdmax = 0; #endif Int tsec, tusec; Term tout = TermNil, ti, Head; if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "socket_select/5"); return (FALSE); } if (!IsPairTerm(t1)) { Yap_Error(TYPE_ERROR_LIST, t1, "socket_select/5"); return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "socket_select/5"); return (FALSE); } if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "socket_select/5"); return (FALSE); } if (IsVarTerm(t3)) { Yap_Error(INSTANTIATION_ERROR, t3, "socket_select/5"); return (FALSE); } if (!IsIntegerTerm(t3)) { Yap_Error(TYPE_ERROR_INTEGER, t3, "socket_select/5"); return (FALSE); } FD_ZERO(&readfds); FD_ZERO(&writefds); FD_ZERO(&exceptfds); /* fetch the input streams */ ti = t1; while (ti != TermNil) { #if _MSC_VER || defined(__MINGW32__) u_int fd; #else int fd; #endif int sno; Head = HeadOfTerm(ti); sno = Yap_CheckIOStream(Head, "stream_select/5"); if (sno < 0) return (FALSE); fd = Yap_GetStreamFd(sno); FD_SET(fd, &readfds); if (fd > fdmax) fdmax = fd; ti = TailOfTerm(ti); } /* now, check the time */ tsec = IntegerOfTerm(t2); tusec = IntegerOfTerm(t3); if (tsec < 0) /* off */ { ptime = NULL; } else { timeout.tv_sec = tsec; timeout.tv_usec = tusec; ptime = &timeout; } /* do the real work */ if (select(fdmax + 1, &readfds, &writefds, &exceptfds, ptime) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_select/5 (select: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_select/5 (select)"); #endif } tout = select_out_list(t1, &readfds PASS_REGS); /* we're done, just pass the info back */ return (Yap_unify(ARG4, tout)); } static Int p_current_host(USES_REGS1) { char oname[MAXHOSTNAMELEN], *name; Term t1 = Deref(ARG1), out; if (!IsVarTerm(t1) && !IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "current_host/2"); return (FALSE); } name = oname; if (gethostname(name, sizeof(oname)) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "current_host/2 (gethostname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "current_host/2 (gethostname)"); #endif return (FALSE); } if ((strrchr(name, '.') == NULL)) { struct hostent *he; /* not a fully qualified name, ask the name server */ if ((he = gethostbyname(name)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "current_host/2 (gethostbyname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "current_host/2 (gethostbyname)"); #endif return (FALSE); } name = (char *)(he->h_name); } if (IsAtomTerm(t1)) { char *sin = RepAtom(AtomOfTerm(t1))->StrOfAE; int faq = (strrchr(sin, '.') != NULL); if (faq) #if _MSC_VER || defined(__MINGW32__) return (_stricmp(name, sin) == 0); #else return (strcasecmp(name, sin) == 0); #endif else { int isize = strlen(sin); if (isize >= 256) { Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "current_host/2 (input longer than longest FAQ host name)"); return (FALSE); } if (name[isize] != '.') return (FALSE); name[isize] = '\0'; #if _MSC_VER || defined(__MINGW32__) return (_stricmp(name, sin) == 0); #else return (strcasecmp(name, sin) == 0); #endif } } else { out = MkAtomTerm(Yap_LookupAtom(name)); return (Yap_unify(ARG1, out)); } } static Int p_hostname_address(USES_REGS1) { char *s; Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term tin, out; struct hostent *he; if (!IsVarTerm(t1)) { if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "hostname_address/2"); return (FALSE); } else tin = t1; } else if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t1, "hostname_address/5"); return (FALSE); } else if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "hostname_address/2"); return (FALSE); } else tin = t2; s = RepAtom(AtomOfTerm(tin))->StrOfAE; if (IsVarTerm(t1)) { if ((he = gethostbyaddr(s, strlen(s), AF_INET)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "hostname_address/2 (gethostbyname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "hostname_address/2 (gethostbyname)"); #endif } out = MkAtomTerm(Yap_LookupAtom((char *)(he->h_name))); return (Yap_unify(out, ARG1)); } else { struct in_addr adr; if ((he = gethostbyname(s)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "hostname_address/2 (gethostbyname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "hostname_address/2 (gethostbyname)"); #endif } memcpy((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length); out = MkAtomTerm(Yap_LookupAtom(inet_ntoa(adr))); return (Yap_unify(out, ARG2)); } } #endif void Yap_InitSocketLayer(void) { #ifdef HAVE_SOCKET Yap_InitCPred("socket", 4, p_socket, SafePredFlag | SyncPredFlag); Yap_InitCPred("socket_close", 1, p_socket_close, SafePredFlag | SyncPredFlag); Yap_InitCPred("socket_bind", 2, p_socket_bind, SafePredFlag | SyncPredFlag); Yap_InitCPred("socket_connect", 3, p_socket_connect, SafePredFlag | SyncPredFlag); Yap_InitCPred("socket_listen", 2, p_socket_listen, SafePredFlag | SyncPredFlag); Yap_InitCPred("socket_accept", 3, p_socket_accept, SafePredFlag | SyncPredFlag); Yap_InitCPred("$socket_buffering", 4, p_socket_buffering, SafePredFlag | SyncPredFlag | HiddenPredFlag); Yap_InitCPred("$socket_select", 4, p_socket_select, SafePredFlag | SyncPredFlag | HiddenPredFlag); Yap_InitCPred("current_host", 1, p_current_host, SafePredFlag); Yap_InitCPred("hostname_address", 2, p_hostname_address, SafePredFlag); #if _MSC_VER || defined(__MINGW32__) { WSADATA info; if (WSAStartup(MAKEWORD(2, 1), &info) != 0) exit(1); } #endif #endif }