fix SICStus compatibility bugs in sockets
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@145 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
94271789ef
commit
8404e8eaff
116
C/ypsocks.c
116
C/ypsocks.c
@ -177,6 +177,10 @@
|
||||
#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
|
||||
@ -896,6 +900,86 @@ p_socket_accept(void)
|
||||
return(unify(out,ARG3));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_socket_buffering(void)
|
||||
{
|
||||
Term t1 = Deref(ARG1);
|
||||
Term t2 = Deref(ARG2);
|
||||
Term t4 = Deref(ARG4);
|
||||
Atom mode;
|
||||
int fd, len;
|
||||
int writing;
|
||||
int bufsize;
|
||||
int sno;
|
||||
|
||||
if ((sno = CheckSocketStream(t1, "socket_buffering/4")) < 0) {
|
||||
return (FALSE);
|
||||
}
|
||||
if (IsVarTerm(t2)) {
|
||||
Error(INSTANTIATION_ERROR,t2,"socket_buffering/4");
|
||||
return(FALSE);
|
||||
}
|
||||
if (!IsAtomTerm(t2)) {
|
||||
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 {
|
||||
Error(DOMAIN_ERROR_IO_MODE,t2,"socket_buffering/4");
|
||||
return(FALSE);
|
||||
}
|
||||
fd = GetStreamFd(sno);
|
||||
if (writing) {
|
||||
getsockopt(fd, SOL_SOCKET, SO_SNDBUF, &bufsize, &len);
|
||||
} else {
|
||||
getsockopt(fd, SOL_SOCKET, SO_RCVBUF, &bufsize, &len);
|
||||
}
|
||||
if (!unify(ARG3,MkIntegerTerm(bufsize)))
|
||||
return(FALSE);
|
||||
if (IsVarTerm(t4)) {
|
||||
bufsize = BUFSIZ;
|
||||
}
|
||||
if (!IsIntegerTerm(t4)) {
|
||||
Error(TYPE_ERROR_INTEGER,t4,"socket_buffering/4");
|
||||
return(FALSE);
|
||||
}
|
||||
bufsize = IntegerOfTerm(t4);
|
||||
if (bufsize < 0) {
|
||||
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t4,"socket_buffering/4");
|
||||
return(FALSE);
|
||||
}
|
||||
if (writing) {
|
||||
setsockopt(fd, SOL_SOCKET, SO_SNDBUF, &bufsize, sizeof(bufsize));
|
||||
} else {
|
||||
setsockopt(fd, SOL_SOCKET, SO_RCVBUF, &bufsize, sizeof(bufsize));
|
||||
}
|
||||
return(TRUE);
|
||||
}
|
||||
|
||||
static Term
|
||||
select_out_list(Term t1, fd_set *readfds_ptr)
|
||||
{
|
||||
if (t1 == TermNil) {
|
||||
return(TermNil);
|
||||
} else {
|
||||
int fd;
|
||||
int sno;
|
||||
Term next = select_out_list(TailOfTerm(t1), readfds_ptr);
|
||||
Term Head = HeadOfTerm(t1);
|
||||
|
||||
sno = CheckIOStream(Head,"stream_select/5");
|
||||
fd = GetStreamFd(sno);
|
||||
if (FD_ISSET(fd, readfds_ptr))
|
||||
return(MkPairTerm(Head,next));
|
||||
else
|
||||
return(MkPairTerm(TermNil,next));
|
||||
}
|
||||
}
|
||||
|
||||
static Int
|
||||
p_socket_select(void)
|
||||
{
|
||||
@ -980,40 +1064,29 @@ p_socket_select(void)
|
||||
"socket_select/5 (select)");
|
||||
#endif
|
||||
}
|
||||
while (t1 != TermNil) {
|
||||
int fd;
|
||||
int sno;
|
||||
|
||||
Head = HeadOfTerm(t1);
|
||||
sno = CheckIOStream(Head,"stream_select/5");
|
||||
fd = GetStreamFd(sno);
|
||||
if (FD_ISSET(fd, &readfds))
|
||||
tout = MkPairTerm(Head,tout);
|
||||
else
|
||||
tout = MkPairTerm(TermNil,tout);
|
||||
t1 = TailOfTerm(t1);
|
||||
}
|
||||
tout = select_out_list(t1, &readfds);
|
||||
/* we're done, just pass the info back */
|
||||
return(unify(ARG4,tout));
|
||||
}
|
||||
|
||||
|
||||
static Int
|
||||
p_current_hostname(void) {
|
||||
p_current_host(void) {
|
||||
char oname[MAXHOSTNAMELEN], *name;
|
||||
Term t1 = Deref(ARG1), out;
|
||||
|
||||
if (!IsVarTerm(t1) && !IsAtomTerm(t1)) {
|
||||
Error(TYPE_ERROR_ATOM,t1,"current_hostname/2");
|
||||
Error(TYPE_ERROR_ATOM,t1,"current_host/2");
|
||||
return(FALSE);
|
||||
}
|
||||
name = oname;
|
||||
if (gethostname(name, sizeof(oname)) < 0) {
|
||||
#if HAVE_STRERROR
|
||||
Error(SYSTEM_ERROR, TermNil,
|
||||
"current_hostname/2 (gethostname: %s)", strerror(socket_errno));
|
||||
"current_host/2 (gethostname: %s)", strerror(socket_errno));
|
||||
#else
|
||||
Error(SYSTEM_ERROR, TermNil,
|
||||
"current_hostname/2 (gethostname)");
|
||||
"current_host/2 (gethostname)");
|
||||
#endif
|
||||
return(FALSE);
|
||||
}
|
||||
@ -1024,10 +1097,10 @@ p_current_hostname(void) {
|
||||
if((he=gethostbyname(name))==NULL) {
|
||||
#if HAVE_STRERROR
|
||||
Error(SYSTEM_ERROR, TermNil,
|
||||
"current_hostname/2 (gethostbyname: %s)", strerror(socket_errno));
|
||||
"current_host/2 (gethostbyname: %s)", strerror(socket_errno));
|
||||
#else
|
||||
Error(SYSTEM_ERROR, TermNil,
|
||||
"current_hostname/2 (gethostbyname)");
|
||||
"current_host/2 (gethostbyname)");
|
||||
#endif
|
||||
return(FALSE);
|
||||
}
|
||||
@ -1047,7 +1120,7 @@ p_current_hostname(void) {
|
||||
int isize = strlen(sin);
|
||||
if (isize >= 256) {
|
||||
Error(SYSTEM_ERROR, ARG1,
|
||||
"current_hostname/2 (input longer than longest FAQ host name)");
|
||||
"current_host/2 (input longer than longest FAQ host name)");
|
||||
return(FALSE);
|
||||
}
|
||||
if (name[isize] != '.') return(FALSE);
|
||||
@ -1126,8 +1199,9 @@ InitSockets(void)
|
||||
InitCPred("socket_connect", 3, p_socket_connect, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("socket_listen", 2, p_socket_listen, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("socket_accept", 3, p_socket_accept, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("$socket_buffering", 4, p_socket_buffering, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("$socket_select", 4, p_socket_select, SafePredFlag|SyncPredFlag);
|
||||
InitCPred("current_hostname", 1, p_current_hostname, SafePredFlag);
|
||||
InitCPred("current_host", 1, p_current_host, SafePredFlag);
|
||||
InitCPred("hostname_address", 2, p_hostname_address, SafePredFlag);
|
||||
#if _MSC_VER || defined(__MINGW32__)
|
||||
{
|
||||
|
||||
@ -16,6 +16,11 @@
|
||||
|
||||
<h2>Yap-4.3.20:</h2>
|
||||
<ul>
|
||||
<li>NEW: socket_buffering/4 (report from Henrik Boström)..</li>
|
||||
<li>FIXED: current_hostname/1 to current_host/1 (report from
|
||||
Henrik Boström)..</li>
|
||||
<li>FIXED: socket_select/5 was completely broken (report from
|
||||
Henrik Boström).</li>
|
||||
<li>FIXED: avoid unnecessary choice-point in
|
||||
yap_flag(user_*,Who) (report from Nicos Angelopoulos).</li>
|
||||
<li>FIXED: flush should work with readline.</li>
|
||||
|
||||
11
docs/yap.tex
11
docs/yap.tex
@ -4422,6 +4422,15 @@ the IP address for the client in numbers and dots notation.
|
||||
@cnindex socket_accept/2
|
||||
Accept a connection but do not return client information.
|
||||
|
||||
@item socket_buffering(+@var{SOCKET}, -@var{MODE}, -@var{OLD}, +@var{NEW})
|
||||
@findex socket_buffering/4
|
||||
@syindex socket_buffering/4
|
||||
@cnindex socket_buffering/4
|
||||
Set buffering for @var{SOCKET} in @code{read} or @code{write}
|
||||
@var{MODE}. @var{OLD} is unified with the previous status, and @var{NEW}
|
||||
receives the new status which may be one of @code{unbuf} or
|
||||
@code{fullbuf}.
|
||||
|
||||
@item socket_select(+@var{SOCKETS}, -@var{NEWSTREAMS}, +@var{TIMEOUT}, +@var{STREAMS}, -@var{READSTREAMS})
|
||||
@findex socket_select/5
|
||||
@syindex socket_select/5
|
||||
@ -4443,7 +4452,7 @@ the form @var{KEY-STREAM}, where @var{KEY} was the key for a socket
|
||||
with pending data, and @var{STREAM} the stream descriptor resulting
|
||||
from accepting the connection.
|
||||
|
||||
@item current_hostname(?@var{HOSTNAME})
|
||||
@item current_host(?@var{HOSTNAME})
|
||||
Unify @var{HOSTNAME} with an atom representing the fully qualified
|
||||
hostname for the current host. Also succeeds if @var{HOSTNAME} is bound
|
||||
to the unqualified hostname.
|
||||
|
||||
@ -24,8 +24,7 @@ socket_accept(S,F) :-
|
||||
socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
|
||||
'$check_list'(Socks, socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams)),
|
||||
'$check_list'(Streams, socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams)),
|
||||
'$select_cp_fds'(Socks, [], Fdi),
|
||||
'$select_cp_fds'(Streams, Fdi, Fds),
|
||||
'$select_cp_fds'(Socks, Streams, Fds),
|
||||
'$check_select_time'(TimeOut, Sec, USec, socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams)),
|
||||
'$socket_select'(Fds, Sec, USec, NFds),
|
||||
'$cp_socket_fds'(Socks, NFds, OutSocks, NFdsS),
|
||||
@ -42,8 +41,8 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
|
||||
throw(error(type_error(list,T),G)).
|
||||
|
||||
'$select_cp_fds'([], Fds, Fds).
|
||||
'$select_cp_fds'([_-Fd|L], Fds0, Fds) :-
|
||||
'$select_cp_fds'([H|L], [Fd|Fds0], Fds).
|
||||
'$select_cp_fds'([_-Fd|L], Fds0, [Fd|Fds]) :-
|
||||
'$select_cp_fds'(L, Fds0, Fds).
|
||||
|
||||
'$check_select_time'(V, Sec, USec, Goal) :-
|
||||
var(V), !,
|
||||
@ -55,16 +54,28 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
|
||||
Sec > 0, USec > 0.
|
||||
|
||||
'$cp_socket_fds'([], Fds, [], Fds).
|
||||
'$cp_socket_fds'([_|Scks], [[]|Fds], Out, StrFds) ;- !,
|
||||
'$cp_socket_fds'([_|Scks], [[]|Fds], Out, StrFds) :- !,
|
||||
'$cp_socket_fds'(Scks, Fds, Out, StrFds).
|
||||
'$cp_socket_fds'([T-Socket|Scks], [Socket|Fds], [T-connection(Client,Stream)|Out], StrFds) :-
|
||||
socket_accept(Socket, Client, Stream),
|
||||
'$cp_socket_fds'(Scks, Fds, Out, StrFds).
|
||||
'$cp_socket_fds'([T-Socket|Scks], [Socket|Fds], Out, StrFds) ;-
|
||||
stream_accept(Socket, Client, Stream),
|
||||
'$cp_socket_fds'(Scks, Fds, [T-connection(Client,Stream)|Out], StrFds).
|
||||
|
||||
'$cp_stream_fds'([], Fds, [], Fds).
|
||||
'$cp_stream_fds'([_|Strs], [[]|Fds], Out) ;- !,
|
||||
'$cp_stream_fds'([], Fds, []).
|
||||
'$cp_stream_fds'([_|Strs], [[]|Fds], Out) :- !,
|
||||
'$cp_stream_fds'(Strs, Fds, Out).
|
||||
'$cp_stream_fds'([Stream|Strs], [Stream|Fds], [Stream|Out]) :-
|
||||
'$cp_stream_fds'(Strs, Fds, Out).
|
||||
'$cp_stream_fds'([T-Stream|Strs], [Stream|Fds], Out, StrFds) ;-
|
||||
stream_accept(Stream, Client, Stream),
|
||||
'$cp_stream_fds'(Strs, Fds, [T-Stream|Out], StrFds).
|
||||
|
||||
socket_buffering(Sock, Flag, InSize, OutSize) :-
|
||||
var(OutSize), OutSize \= InSize, !,
|
||||
throw(error(instantiation_error,socket_buffering(Sock, Flag, InSize, OutSize))).
|
||||
socket_buffering(Sock, Flag, InSize, OutSize) :-
|
||||
'$convert_sock_buff'(InSize, InNumb),
|
||||
'$socket_buffering'(Sock, Flag, InNumb, OutNumb),
|
||||
'$convert_sock_buff'(OutSize, OutNumb).
|
||||
|
||||
'$convert_sock_buff'(unbuf, 1) :- !.
|
||||
'$convert_sock_buff'(fullbuf, InNumb).
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user