MODULE Sockets;
IMPORT S := SYSTEM, Unix, Trace, IP;
CONST
backlog = 5;
TYPE
Address = S.ADDRESS;
SocketAdr* = POINTER TO RECORD
family* : INTEGER;
port* : INTEGER;
END;
SocketAdrV4* = POINTER TO RECORD (SocketAdr)
v4Adr* : LONGINT;
zero* : ARRAY 8 OF CHAR
END;
SocketAdrV6* = POINTER TO RECORD (SocketAdr)
flowinfo* : LONGINT;
v6Adr* : ARRAY 16 OF CHAR;
scopeId* : LONGINT;
srcId* : LONGINT
END;
NameBuf = POINTER TO RECORD
buf: ARRAY 64 OF CHAR
END;
SocketOption = POINTER TO RECORD END;
Linger = POINTER TO RECORD (SocketOption)
onoff : LONGINT;
linger : LONGINT;
END;
Switch = POINTER TO RECORD (SocketOption)
onoff : LONGINT
END;
CONST
LingerSize = 8;
VAR
socket : PROCEDURE {C} ( af, typ, protocol: LONGINT ): LONGINT;
setsockopt : PROCEDURE {C} ( s: LONGINT; level, optname: LONGINT; opt: SocketOption; optlen: LONGINT): LONGINT;
accept : PROCEDURE {C} ( s: LONGINT; adrPtr: Address; VAR adrlen: LONGINT ): LONGINT;
bind : PROCEDURE {C} ( s: LONGINT; adr: SocketAdr; adrlen: LONGINT ): LONGINT;
connect : PROCEDURE {C} ( s: LONGINT; adr: SocketAdr; adrlen: LONGINT ): LONGINT;
listen : PROCEDURE {C} ( s: LONGINT; backlog: LONGINT ): LONGINT;
recv : PROCEDURE {C} ( s: LONGINT; buf: Address; len, flags: LONGINT ): LONGINT;
send : PROCEDURE {C} ( s: LONGINT; buf: Address; len, flags: LONGINT ): LONGINT;
recvfrom : PROCEDURE {C} ( s: LONGINT; buf: Address; len, flags: LONGINT; from: NameBuf; VAR flen: LONGINT ): LONGINT;
sendto : PROCEDURE {C} ( s: LONGINT; buf: Address; len, flags: LONGINT; to: SocketAdr; tolen: LONGINT ): LONGINT;
shutdown : PROCEDURE {C} ( s: LONGINT; how: LONGINT );
getpeername : PROCEDURE {C} ( s: LONGINT; adr: NameBuf; VAR adrlen: LONGINT ): LONGINT;
getsockname : PROCEDURE {C} ( s: LONGINT; adr: NameBuf; VAR adrlen: LONGINT ): LONGINT;
htonl : PROCEDURE {C} ( hostlong : LONGINT ): LONGINT;
htons : PROCEDURE {C} ( hostshort : LONGINT ): LONGINT;
ntohl : PROCEDURE {C} ( netlong : LONGINT ): LONGINT;
ntohs : PROCEDURE {C} ( netshort : LONGINT ): LONGINT;
PROCEDURE NewSocketAdr*( ip: IP.Adr; port: LONGINT ): SocketAdr;
VAR sadr4: SocketAdrV4; sadr6: SocketAdrV6; i: LONGINT;
BEGIN
CASE ip.usedProtocol OF
| -1:
NEW( sadr4 );
sadr4.family := Unix.AFINET;
sadr4.port := IntToNet( SHORT( port ) );
sadr4.v4Adr := 0;
RETURN sadr4
| IP.IPv4:
NEW( sadr4 );
sadr4.family := Unix.AFINET;
sadr4.port := IntToNet( SHORT( port ) );
sadr4.v4Adr := ip.ipv4Adr;
RETURN sadr4
| IP.IPv6:
NEW( sadr6 );
sadr6.family := Unix.AFINET6;
sadr6.port := IntToNet( SHORT( port ) );
sadr6.flowinfo := 0;
FOR i := 0 TO 15 DO sadr6.v6Adr[i] := ip.ipv6Adr[i] END;
sadr6.scopeId := 0;
sadr6.srcId := 0;
RETURN sadr6
ELSE
HALT( 99 )
END
END NewSocketAdr;
PROCEDURE SockAdrToIPAdr*( sadr: SocketAdr ): IP.Adr;
VAR ip: IP.Adr; i: LONGINT;
BEGIN
IF sadr IS SocketAdrV4 THEN
ip.usedProtocol := IP.IPv4;
ip.ipv4Adr := sadr(SocketAdrV4).v4Adr;
ip.ipv6Adr := ""
ELSE
ip.usedProtocol := IP.IPv6;
ip.ipv4Adr := 0;
FOR i := 0 TO 15 DO
ip.ipv6Adr[i] := sadr(SocketAdrV6).v6Adr[i]
END
END;
RETURN ip
END SockAdrToIPAdr;
PROCEDURE GetPortNumber*( sadr: SocketAdr ): LONGINT;
VAR port: LONGINT;
BEGIN
port := NetToInt( sadr.port );
IF port < 0 THEN port := port + 10000H END;
RETURN port
END GetPortNumber;
PROCEDURE BufToSocketAdr( CONST buf: ARRAY OF CHAR; len: LONGINT ): SocketAdr;
VAR adr4: SocketAdrV4; adr6: SocketAdrV6;
BEGIN
IF len = Unix.SockAddrSizeV4 THEN
NEW( adr4 );
S.MOVE( S.ADR( buf ), S.ADR( adr4^), len );
RETURN adr4
ELSE
NEW( adr6 );
S.MOVE( S.ADR( buf ), S.ADR( adr6^), len );
RETURN adr6
END
END BufToSocketAdr;
PROCEDURE Accept*( s: LONGINT ): LONGINT;
VAR len, err: LONGINT; new: LONGINT;
BEGIN
len := 0;
REPEAT
new := accept( s, 0, len );
IF new < 0 THEN err := Unix.errno() END
UNTIL (new > 0) OR (err # Unix.EINTR);
IF new < 0 THEN Unix.Perror( "Sockets.Accept" ) END;
RETURN new
END Accept;
PROCEDURE Bind*( s: LONGINT; addr: SocketAdr): BOOLEAN;
VAR err, len: LONGINT;
BEGIN
IF addr.family = Unix.AFINET THEN len := Unix.SockAddrSizeV4 ELSE len := Unix.SockAddrSizeV6 END;
err:= bind( s, addr, len );
RETURN err = 0
END Bind;
PROCEDURE Close*( s: LONGINT );
VAR err: LONGINT;
BEGIN
shutdown( s, Unix.ShutRDWR );
err := Unix.close( s );
END Close;
PROCEDURE Connect*( s: LONGINT; addr: SocketAdr ): BOOLEAN;
VAR err, len: LONGINT;
BEGIN
IF addr.family = Unix.AFINET THEN len := Unix.SockAddrSizeV4 ELSE len := Unix.SockAddrSizeV6 END;
err:= connect( s, addr, len );
IF err = 0 THEN
RETURN TRUE
ELSE
Unix.Perror( "Sockets.Connect: " );
RETURN FALSE
END;
RETURN err = 0
END Connect;
PROCEDURE GetSockName*( s: LONGINT ): SocketAdr;
VAR len, err: LONGINT; buf: NameBuf;
BEGIN
NEW( buf ); len := 64;
err := getsockname( s, buf, len );
IF err = 0 THEN
RETURN BufToSocketAdr( buf.buf, len )
ELSE
Unix.Perror( "Sockets.GetSockName" );
RETURN NIL
END
END GetSockName;
PROCEDURE GetPeerName*( s: LONGINT ): SocketAdr;
VAR err, len: LONGINT; buf: NameBuf;
BEGIN
NEW( buf ); len := 64;
err:= getpeername( s, buf, len );
IF err = 0 THEN
RETURN BufToSocketAdr( buf.buf, len )
ELSE
Unix.Perror( "Sockets.GetPeerName" );
RETURN NIL
END
END GetPeerName;
PROCEDURE Listen*( s: LONGINT ): BOOLEAN;
VAR err: LONGINT;
BEGIN
err := listen( s, backlog );
RETURN err = 0
END Listen;
PROCEDURE Recv*( s: LONGINT; VAR buf: ARRAY OF CHAR; pos: LONGINT; VAR len: LONGINT; flags: LONGINT ): BOOLEAN;
VAR res, err: LONGINT;
BEGIN
REPEAT
res := recv( s, S.ADR( buf[pos] ), len, flags );
IF res < 0 THEN err := Unix.errno() END
UNTIL (res >= 0) OR (err # Unix.EINTR);
IF err >= 0 THEN
len:= res; RETURN TRUE
ELSE
Unix.Perror( "Sockets.Recv" );
len:= 0; RETURN FALSE
END
END Recv;
PROCEDURE Send*( s: LONGINT; CONST buf: ARRAY OF CHAR; pos: LONGINT; VAR len: LONGINT ): BOOLEAN;
VAR err: LONGINT;
BEGIN
ASSERT( LEN(buf)-pos >= len );
err := send( s, S.ADR( buf[pos] ), len, 0 );
IF err >= 0 THEN
len := err; RETURN TRUE
ELSE
Unix.Perror( "Sockets.Send" );
len := 0; RETURN FALSE
END
END Send;
PROCEDURE RecvFrom*( s: LONGINT; VAR from: SocketAdr;
VAR buf: ARRAY OF CHAR; pos: LONGINT; VAR len: LONGINT ): BOOLEAN;
VAR res, err, size: LONGINT; nbuf: NameBuf;
BEGIN
NEW( nbuf ); size := 64;
REPEAT
res := recvfrom( s, S.ADR(buf[pos]), LEN( buf ) - pos, 0, nbuf, size );
IF res < 0 THEN err := Unix.errno() END
UNTIL (res >= 0) OR (err # Unix.EINTR);
IF res >= 0 THEN
from := BufToSocketAdr( nbuf.buf, size );
len := res; RETURN TRUE
ELSE
Unix.Perror( "Sockets.RecvFrom" );
len := 0; RETURN FALSE
END
END RecvFrom;
PROCEDURE SendTo*( s: LONGINT; dest: SocketAdr; CONST buf: ARRAY OF CHAR; pos, len: LONGINT ): BOOLEAN;
VAR err, size: LONGINT;
BEGIN
ASSERT( LEN(buf) - pos >= len );
IF dest.family = Unix.AFINET THEN size := Unix.SockAddrSizeV4 ELSE size := Unix.SockAddrSizeV6 END;
err:= sendto( s, S.ADR( buf[pos] ), len, 0, dest, size );
IF err >= 0 THEN
RETURN TRUE
ELSE
Unix.Perror( "Sockets.SendTo" );
RETURN FALSE
END
END SendTo;
PROCEDURE Socket* ( af, typ, protocol: LONGINT ): LONGINT;
VAR s: LONGINT;
BEGIN
s := socket( af, typ, protocol );
RETURN s
END Socket;
PROCEDURE Available*( s: LONGINT ): LONGINT;
VAR available, err: LONGINT;
BEGIN
available := 0;
err := Unix.ioctl( s, Unix.FioNRead, S.ADR( available ) );
IF err = 0 THEN
RETURN available
ELSE
Unix.Perror( "Sockets.Available (ioctl)" );
RETURN -1
END
END Available;
PROCEDURE Requested*( s: LONGINT ): BOOLEAN;
VAR res, i: LONGINT;
readfds: Unix.FdSet;
timeout: Unix.Timeval;
BEGIN
timeout.sec := 0; timeout.usec := 0;
FOR i := 0 TO LEN( readfds ) - 1 DO readfds[i] := {} END;
INCL( readfds[s DIV 32], s MOD 32 );
res := Unix.select( s+1, S.VAL( Unix.FdSetPtr, S.ADR( readfds ) ), NIL, NIL, timeout );
IF res <= 0 THEN RETURN FALSE ELSE RETURN TRUE END;
END Requested;
PROCEDURE AwaitPacket*( s: LONGINT; ms: LONGINT ): BOOLEAN;
VAR res, err, i: LONGINT;
readfds: Unix.FdSet;
timeout: Unix.Timeval;
BEGIN
timeout.sec := ms DIV 1000; ms := ms MOD 1000;
timeout.usec := 1000*ms;
FOR i := 0 TO LEN( readfds ) - 1 DO readfds[i] := {} END;
INCL( readfds[s DIV 32], s MOD 32 );
REPEAT
res := Unix.select( s+1, S.VAL( Unix.FdSetPtr, S.ADR( readfds ) ), NIL, NIL, timeout );
IF res < 0 THEN err := Unix.errno() END
UNTIL (res >= 0) OR (err # Unix.EINTR);
IF res <= 0 THEN RETURN FALSE ELSE RETURN TRUE END;
END AwaitPacket;
PROCEDURE SetLinger* ( s: LONGINT ): BOOLEAN;
VAR
linger: Linger;
err: LONGINT;
BEGIN
NEW( linger); linger.onoff := 1; linger.linger := 1;
err := setsockopt( s, Unix.SoLSocket, Unix.SoLinger, linger, LingerSize );
IF err # 0 THEN Unix.Perror( "Sockets.SetLinger (setsockopt)" ) END;
RETURN err = 0
END SetLinger;
PROCEDURE KeepAlive* ( s: LONGINT; enable: BOOLEAN ): BOOLEAN;
VAR
opt: Switch;
err: LONGINT;
BEGIN
NEW( opt );
IF enable THEN opt.onoff := 1 ELSE opt.onoff := 0 END;
err := setsockopt( s, Unix.SoLSocket, Unix.SoKeepAlive, opt, 4 );
IF err # 0 THEN Unix.Perror( "Sockets.KeepAlive (setsockopt)" ) END;
RETURN err = 0
END KeepAlive;
PROCEDURE NoDelay* ( s: LONGINT; enable: BOOLEAN ): BOOLEAN;
VAR
opt: Switch;
err: LONGINT;
BEGIN
NEW( opt );
IF enable THEN opt.onoff := 1 ELSE opt.onoff := 0 END;
err := setsockopt( s, Unix.SoLSocket, Unix.SoNoDelay, opt, 4 );
IF err # 0 THEN Unix.Perror( "Sockets.NoDelay (setsockopt)" ) END;
RETURN err = 0
END NoDelay;
PROCEDURE NetToInt* (x: INTEGER): INTEGER;
BEGIN
RETURN SHORT(ntohs(LONG(x)))
END NetToInt;
PROCEDURE IntToNet* (x: INTEGER): INTEGER;
BEGIN
RETURN SHORT(htons(LONG(x)))
END IntToNet;
PROCEDURE NetToLInt* (x: LONGINT): LONGINT;
BEGIN
RETURN ntohl(x)
END NetToLInt;
PROCEDURE LIntToNet* (x: LONGINT): LONGINT;
BEGIN
RETURN htonl(x)
END LIntToNet;
PROCEDURE Init;
VAR slib: LONGINT;
BEGIN
IF Unix.sysinfo.sysname = "SunOS" THEN
slib := Unix.Dlopen( "libsocket.so.1", 2 );
IF slib = 0 THEN slib := Unix.Dlopen( "libsocket.so", 2 ) END;
IF slib = 0 THEN Trace.StringLn( "Unix.Dlopen( 'libsocket.so' ) failed") END;
ELSE
slib := Unix.libc
END;
Unix.Dlsym( slib, "accept", S.VAL( Address, accept ) );
Unix.Dlsym( slib, "bind", S.VAL( Address, bind ) );
Unix.Dlsym( slib, "connect", S.VAL( Address, connect ) );
Unix.Dlsym( slib, "shutdown", S.VAL( Address, shutdown ) );
Unix.Dlsym( slib, "getpeername", S.VAL( Address, getpeername ) );
Unix.Dlsym( slib, "htonl", S.VAL( Address, htonl ) );
Unix.Dlsym( slib, "htons", S.VAL( Address, htons ) );
Unix.Dlsym( slib, "listen", S.VAL( Address, listen ) );
Unix.Dlsym( slib, "ntohl", S.VAL( Address, ntohl ) );
Unix.Dlsym( slib, "ntohs", S.VAL( Address, ntohs ) );
Unix.Dlsym( slib, "recv", S.VAL( Address, recv ) );
Unix.Dlsym( slib, "recvfrom", S.VAL( Address, recvfrom ) );
Unix.Dlsym( slib, "send", S.VAL( Address, send ) );
Unix.Dlsym( slib, "sendto", S.VAL( Address, sendto ) );
Unix.Dlsym( slib, "setsockopt", S.VAL( Address, setsockopt ) );
Unix.Dlsym( slib, "socket", S.VAL( Address, socket ) );
Unix.Dlsym( slib, "getsockname", S.VAL( Address, getsockname ) );
END Init;
BEGIN
Init
END Sockets.