(* Copyright 1992 Digital Equipment Corporation. *)
(* Distributed only by permission. *)
(* Created on Sat Jan 11 15:49:00 PST 1992 by gnelson *)
(* Last modified on Thu Jan 4 11:07:56 PST 1996 by heydon *)
(* modified on Wed Jun 29 08:47:41 PDT 1994 by kalsow *)
(* modified on Thu Apr 7 13:23:03 PDT 1994 by wobber *)
(* modified on Fri Jan 7 13:31:11 PST 1994 by msm *)
(* modified on Sun Jan 12 16:16:54 PST 1992 by meehan *)
(* modified on Sat Jan 11 16:55:00 PST 1992 by gnelson *)
UNSAFE MODULE TCP EXPORTS TCP, TCPSpecial, Uin;
IMPORT Atom, AtomList, ConnFD, IP, Rd, Wr, Thread;
IMPORT Usocket, Cerrno, Uerror, Uin, Unix, Uuio,
TCPPosix, SchedulerPosix, Fmt, Word;
FROM Ctypes IMPORT char;
IMPORT IO, RTIO;
REVEAL
Connector = MUTEX BRANDED "TCP.Connector" OBJECT
fd: INTEGER; (*CONST*)
ep: IP.Endpoint; (*CONST*)
closed: BOOLEAN := FALSE;
END;
REVEAL
T = TCPPosix.Public BRANDED "TCP.T" OBJECT
ep: IP.Endpoint;
error: AtomList.T := NIL;
OVERRIDES
get := GetBytesFD;
put := PutBytesFD;
shutdownIn := ShutdownIn;
shutdownOut := ShutdownOut;
close := Close;
END;
EXCEPTION FatalError; <* FATAL FatalError *>
TYPE SockAddrIn = Uin.struct_sockaddr_in;
CONST TCP_NODELAY = 1;
CONST Sin_Zero = ARRAY [0 .. 7] OF char{VAL(0, char), ..};
VAR ClosedErr: AtomList.T;
PROCEDURE NewConnector (ep: IP.Endpoint): Connector RAISES {IP.Error} =
VAR
res := NEW(Connector, ep := ep);
name : SockAddrIn;
status: INTEGER;
True := 1;
BEGIN
CheckEndpoint(ep);
res.fd := Usocket.socket(Usocket.AF_INET, Usocket.SOCK_STREAM, 0 (* TCP*));
IF res.fd = -1 THEN
IF Cerrno.errno = Uerror.EMFILE OR Cerrno.errno = Uerror.ENFILE THEN
Raise(IP.NoResources, Cerrno.errno);
ELSE
RAISE FatalError
END
END;
IF Unix.fcntl(res.fd, Unix.F_SETFL,
Word.Or(Unix.fcntl(res.fd, Unix.F_GETFL, 0),
Unix.O_NDELAY)) # 0 THEN
RAISE FatalError
END;
EVAL Usocket.setsockopt(
res.fd, Usocket.SOL_SOCKET, Usocket.SO_REUSEADDR, ADR(True),
BYTESIZE(True));
name.sin_family := Usocket.AF_INET;
name.sin_port := Uin.htons(ep.port);
name.sin_addr.s_addr := ep.addr;
name.sin_zero := Sin_Zero;
status := Usocket.bind(res.fd, ADR(name), BYTESIZE(SockAddrIn));
IF status # 0 THEN
IF Cerrno.errno = Uerror.EADDRINUSE THEN
Raise(IP.PortBusy, Cerrno.errno);
ELSE
RAISE FatalError
END
END;
status := Usocket.listen(res.fd, 5);
IF status # 0 THEN
RAISE FatalError
END;
RETURN res
END NewConnector;
PROCEDURE GetEndPoint(c: Connector): IP.Endpoint =
VAR
namelen : INTEGER;
name : SockAddrIn;
BEGIN
IF c.ep.addr = IP.NullAddress THEN
c.ep.addr := IP.GetHostAddr();
END;
IF c.ep.port = IP.NullPort THEN
namelen := BYTESIZE(SockAddrIn);
IF Usocket.getsockname(c.fd, ADR(name), ADR(namelen)) # 0 THEN
RAISE FatalError;
END;
c.ep.port := Uin.htons(name.sin_port);
END;
RETURN c.ep
END GetEndPoint;
PROCEDURE Connect (ep: IP.Endpoint): T
RAISES {IP.Error, Thread.Alerted} =
VAR
t := StartConnect(ep);
ok := FALSE;
BEGIN
TRY
EVAL FinishConnect(t);
ok := TRUE;
FINALLY
IF NOT ok THEN Close(t); END;
END;
RETURN t;
END Connect;
PROCEDURE StartConnect(ep: IP.Endpoint): T
RAISES {IP.Error} =
VAR
fd: INTEGER;
ok := FALSE;
BEGIN
CheckEndpoint(ep);
fd := Usocket.socket(Usocket.AF_INET, Usocket.SOCK_STREAM, 0 (* TCP*));
IF fd < 0 THEN
IF Cerrno.errno = Uerror.EMFILE OR Cerrno.errno = Uerror.ENFILE THEN
Raise(IP.NoResources, Cerrno.errno);
ELSE
RAISE FatalError;
END;
END;
InitFD(fd);
TRY
EVAL CheckConnect(fd, ep);
ok := TRUE;
FINALLY
IF NOT ok THEN EVAL Unix.close(fd); END;
END;
RETURN NEW(T, fd := fd, ep := ep);
END StartConnect;
PROCEDURE FinishConnect(t: T; timeout: LONGREAL := -1.0D0): BOOLEAN
RAISES {IP.Error, Thread.Alerted} =
BEGIN
LOOP
EVAL SchedulerPosix.IOAlertWait(t.fd, FALSE, timeout);
LOCK t DO
IF t.error # NIL THEN RAISE IP.Error(t.error); END;
IF CheckConnect(t.fd, t.ep) THEN EXIT; END;
END;
IF timeout >= 0.0D0 THEN RETURN FALSE; END;
END;
RETURN TRUE;
END FinishConnect;
PROCEDURE CheckConnect(fd: INTEGER; ep: IP.Endpoint) : BOOLEAN
RAISES {IP.Error} =
VAR
name: SockAddrIn;
status: INTEGER;
BEGIN
name.sin_family := Usocket.AF_INET;
name.sin_port := Uin.htons(ep.port);
name.sin_addr.s_addr := ep.addr;
name.sin_zero := Sin_Zero;
status := Usocket.connect(fd, ADR(name), BYTESIZE(SockAddrIn));
IF status = 0 THEN RETURN TRUE; END;
IF Cerrno.errno = Uerror.EINVAL THEN
(* special hack to try to get real errno, hidden due to NBIO bug in connect *)
VAR optbuf: INTEGER := 0;
optlen := BYTESIZE(optbuf);
BEGIN
EVAL Usocket.getsockopt(fd, Uin.IPPROTO_TCP, TCP_NODELAY, ADR(optbuf), ADR(optlen));
END;
END;
CASE Cerrno.errno OF
| Uerror.EISCONN => RETURN TRUE;
| Uerror.EADDRNOTAVAIL, Uerror.ECONNREFUSED, Uerror.EINVAL =>
(* There is a known bug which causes EINVAL when another error is expected *)
Raise(Refused, Cerrno.errno);
| Uerror.ETIMEDOUT =>
Raise(Timeout, Cerrno.errno);
| Uerror.ENETUNREACH, Uerror.EHOSTUNREACH, Uerror.EHOSTDOWN, Uerror.ENETDOWN =>
Raise(IP.Unreachable, Cerrno.errno);
(* | Uerror.EWOULDBLOCK, Uerror.EAGAIN, Uerror.EINPROGRESS, Uerror.EALREADY => *)
| Uerror.EWOULDBLOCK, Uerror.EINPROGRESS, Uerror.EALREADY =>
ELSE
e := Cerrno.errno;
RAISE FatalError
END;
RETURN FALSE;
END CheckConnect;
VAR
e: INTEGER;
PROCEDURE Accept (c: Connector): T
RAISES {IP.Error, Thread.Alerted} =
VAR
name : SockAddrIn;
nameSize : INTEGER := BYTESIZE(name);
fd : INTEGER;
BEGIN
LOOP
LOCK c DO
IF c.closed THEN RaiseNoEC(Closed); END;
fd := Usocket.accept(c.fd, ADR(name), ADR(nameSize));
END;
IF fd >= 0 THEN
EXIT
ELSIF Cerrno.errno = Uerror.EMFILE OR Cerrno.errno = Uerror.ENFILE THEN
Raise(IP.NoResources, Cerrno.errno);
ELSIF
Cerrno.errno = Uerror.EWOULDBLOCK OR Cerrno.errno = Uerror.EAGAIN
THEN
EVAL SchedulerPosix.IOAlertWait(c.fd, TRUE);
ELSE
RAISE FatalError
END
END;
InitFD(fd);
RETURN NEW(T, fd := fd, ep := IP.NullEndPoint);
END Accept;
PROCEDURE CloseConnector(<*UNUSED*> c: Connector) =
BEGIN
RAISE FatalError;
END CloseConnector;
PROCEDURE EOF(t: T) : BOOLEAN =
VAR
status, charsToRead: INTEGER;
BEGIN
LOCK t DO
IF SchedulerPosix.IOWait(t.fd, TRUE, 0.0D0) =
SchedulerPosix.WaitResult.Ready THEN
status := Unix.ioctl(t.fd, Unix.FIONREAD, ADR(charsToRead));
RETURN (status = 0) AND (charsToRead = 0);
END;
END;
RETURN FALSE;
END EOF;
PROCEDURE CheckEndpoint(ep: IP.Endpoint) RAISES {IP.Error} =
BEGIN
IF ep.addr # Word.Extract(ep.addr, 0, 32) THEN
RaiseNoEC(Refused);
END;
END CheckEndpoint;
(* methods of TCP.T *)
(*
VAR
ignoringSIGPIPEmu := NEW(MUTEX);
ignoringSIGPIPE: BOOLEAN := FALSE;
*)
(*
VAR SysSendBufSize: INTEGER := 65535;
VAR SysRcvBufSize: INTEGER := 65535;
*)
PROCEDURE InitFD(fd: CARDINAL) =
VAR
one := 1;
linger := Usocket.struct_linger{1, 1};
(* vec, oldvec: Usignal.struct_sigvec; *)
BEGIN
(*
LOCK ignoringSIGPIPEmu DO
IF NOT ignoringSIGPIPE THEN
ignoringSIGPIPE := TRUE;
vec := Usignal.struct_sigvec{Usignal.SIG_IGN, 0, 0};
EVAL Usignal.sigvec(Usignal.SIGPIPE, vec, oldvec);
END;
END;
*)
(*
EVAL Usocket.setsockopt(fd, Usocket.SOL_SOCKET, Usocket.SO_SNDBUF,
ADR(SysSendBufSize), BYTESIZE(SysSendBufSize));
EVAL Usocket.setsockopt(fd, Usocket.SOL_SOCKET, Usocket.SO_RCVBUF,
ADR(SysRcvBufSize), BYTESIZE(SysRcvBufSize));
*)
EVAL Usocket.setsockopt(fd, Usocket.SOL_SOCKET, Usocket.SO_LINGER,
ADR(linger), BYTESIZE(linger));
EVAL Usocket.setsockopt(
fd, Uin.IPPROTO_TCP, TCP_NODELAY, ADR(one), BYTESIZE(one));
EVAL Usocket.setsockopt(fd, Usocket.SOL_SOCKET, Usocket.SO_LINGER,
ADR(linger), BYTESIZE(linger));
EVAL Usocket.setsockopt(
fd, Uin.IPPROTO_TCP, TCP_NODELAY, ADR(one), BYTESIZE(one));
IF Unix.fcntl(fd, Unix.F_SETFL,
Word.Or(Unix.fcntl(fd, Unix.F_GETFL, 0), Unix.O_NDELAY)) # 0
THEN
RAISE FatalError
END;
END InitFD;
PROCEDURE Close(t: T) =
BEGIN
LOCK t DO
IF NOT t.closed THEN
EVAL Unix.close(t.fd);
t.closed := TRUE;
t.error := ClosedErr;
END;
END;
END Close;
VAR
l: INTEGER;
PROCEDURE GetBytesFD(
t: T; VAR arr: ARRAY OF CHAR; timeout: LONGREAL) : CARDINAL
RAISES {Rd.Failure, ConnFD.TimedOut, Thread.Alerted} =
VAR
len: INTEGER;
BEGIN
LOOP
LOCK t DO
IF t.error # NIL THEN RAISE Rd.Failure(t.error); END;
len := Uuio.read(t.fd, ADR(arr[0]), NUMBER(arr));
l := len;
END;
IF len >= 0 THEN
RETURN len;
ELSE
e := Cerrno.errno;
CASE Cerrno.errno OF
| Uerror.ECONNRESET => RETURN 0;
| Uerror.EPIPE, Uerror.ENETRESET => SetError(t,ConnLost);
| Uerror.ETIMEDOUT => SetError(t,Timeout);
| Uerror.ENETUNREACH, Uerror.EHOSTUNREACH,
Uerror.EHOSTDOWN, Uerror.ENETDOWN => SetError(t,IP.Unreachable);
(* | Uerror.EWOULDBLOCK, Uerror.EAGAIN => *)
| Uerror.EWOULDBLOCK =>
IF timeout = 0.0D0 OR
SchedulerPosix.IOAlertWait(t.fd, TRUE, timeout) =
SchedulerPosix.WaitResult.Timeout THEN
RAISE ConnFD.TimedOut;
END;
ELSE
RAISE FatalError;
END;
END;
END;
END GetBytesFD;
PROCEDURE PutBytesFD(t: T; VAR arr: ARRAY OF CHAR)
RAISES {Wr.Failure, Thread.Alerted} =
VAR pos := 0;
len: INTEGER;
BEGIN
WHILE pos # NUMBER(arr) DO
LOCK t DO
IF t.error # NIL THEN RAISE Wr.Failure(t.error); END;
len := Uuio.write(t.fd, ADR(arr[pos]), NUMBER(arr)-pos);
END;
IF len >= 0 THEN
INC(pos, len)
ELSE
e := Cerrno.errno;
CASE Cerrno.errno OF
| Uerror.EPIPE, Uerror.ECONNRESET, Uerror.ENETRESET => SetError(t,ConnLost);
| Uerror.ETIMEDOUT => SetError(t,Timeout);
| Uerror.ENETUNREACH, Uerror.EHOSTUNREACH,
Uerror.EHOSTDOWN, Uerror.ENETDOWN => SetError(t,IP.Unreachable);
(* | Uerror.EWOULDBLOCK, Uerror.EAGAIN => *)
| Uerror.EWOULDBLOCK =>
EVAL SchedulerPosix.IOAlertWait(t.fd, FALSE);
(* IF Thread.TestAlert() THEN RAISE Thread.Alerted END *)
ELSE
RAISE FatalError;
END
END
END;
END PutBytesFD;
VAR lastErrorMu := NEW(MUTEX);
lastErrors: ARRAY [0..19] OF INTEGER;
lastErrorPos: CARDINAL := 0;
PROCEDURE SetError(t: T; atom: Atom.T) =
BEGIN
LOCK t DO
t.error := AtomList.List2(atom, Atom.FromText(Fmt.Int(Cerrno.errno)));
LOCK lastErrorMu DO
lastErrors[lastErrorPos] := Cerrno.errno;
INC(lastErrorPos);
IF lastErrorPos >= NUMBER(lastErrors) THEN lastErrorPos := 0; END;
END;
END;
END SetError;
PROCEDURE ShutdownIn(t: T) RAISES {Rd.Failure} =
BEGIN
LOCK t DO
IF t.error # NIL THEN RAISE Rd.Failure(t.error); END;
EVAL Usocket.shutdown(t.fd, 0);
END;
END ShutdownIn;
PROCEDURE ShutdownOut(t: T) RAISES {Wr.Failure} =
BEGIN
LOCK t DO
IF t.error # NIL THEN RAISE Wr.Failure(t.error); END;
EVAL Usocket.shutdown(t.fd, 1);
END;
END ShutdownOut;
PROCEDURE Raise(a: Atom.T; err: INTEGER) RAISES {IP.Error} =
BEGIN
RAISE IP.Error(AtomList.List2(a, Atom.FromText(Fmt.Int(err))));
END Raise;
PROCEDURE RaiseNoEC(a: Atom.T) RAISES {IP.Error} =
BEGIN
RAISE IP.Error(AtomList.List1(a));
END RaiseNoEC;
BEGIN
Refused := Atom.FromText("TCP.Refused");
Closed := Atom.FromText("TCP.Closed");
Timeout := Atom.FromText("TCP.Timeout");
ConnLost := Atom.FromText("TCP.ConnLost");
ClosedErr := AtomList.List1(Closed);
END TCP.
m3-request@src.dec.com
Copyright (C) 1992, 1996, Digital Equipment Corporation. All rights reserved.
See the COPYRIGHT for a full description.