Socket.st
author claus
Wed, 15 Feb 1995 11:29:31 +0100
changeset 58 bd6753bf0401
parent 51 24f978f1d849
child 63 7dd3d5b7877e
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

UnboundedExternalStream subclass:#Socket
       instanceVariableNames:'domain socketType protocol portNr serviceName
			      peerName'
       classVariableNames:''
       poolDictionaries:''
       category:'Streams-External'
!

Socket comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic2/Socket.st,v 1.17 1995-02-15 10:29:23 claus Exp $
'!

!Socket class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libbasic2/Socket.st,v 1.17 1995-02-15 10:29:23 claus Exp $
"
!

documentation
"
    This class provides access to (unix-)sockets for interprocess communication.
    The message protocol is preliminary, until someone tells me how
    other smalltalk's socket interfaces look like.

    Also, currently there is almost no support for other than IP 
    sockets - this will be added in the future.
    Due to historic reasons (I started this class, before I got hold of some
    code using ST-80 Sockets i.e. RemoteInvocation), there is some old interface
    still provided. This will vanish; use the newTCPxxx and newUDPxxx interface,
    which is meant to be compatible to ST-80's UnixSocketAccessor interface.
"
!

examples
"
    example (get help info from an nntp server):

	|sock|

	sock := Socket 
		    newTCPclientToHost:(OperatingSystem 
					    getEnvironment:'NNTPSERVER') 
				  port:'nntp'.
	Transcript showCr:sock nextLine.
	sock buffered:false.

	sock nextPutAll:'HELP'; cr.
	[:exit |
	    |line|

	    line := sock nextLine.
	    line = '.' ifTrue:[exit value:nil].
	    Transcript showCr:line.
	] loopWithExit.
	sock close


    example (connect to an ftp server):

	|sock|

	sock := Socket 
		    newTCPclientToHost:(OperatingSystem getHostName) 
				  port:'ftp'.

	sock buffered:false.
	Transcript showCr:sock nextLine.
	sock nextPutAll:('USER ' , OperatingSystem getLoginName); cr.
	Transcript showCr:sock nextLine.
	sock nextPutAll:('PASS ' , 'fooBar'); cr.
	Transcript showCr:sock nextLine.
	sock nextPutAll:'LIST'; cr.
	Transcript showCr:sock nextLine.

	'dont know enough of the ftp protocol to continue here ...'


    example (connect to an snmp server):

	|sock|

	sock := Socket newUDP:'snpm'.
	sock connectTo:(OperatingSystem getHostName).
	sock buffered:false.
	Transcript showCr:got it'.

    example (await connection from a client and read some data):

	|connectSock sock|

	connectSock := Socket provide:9996.  
	Transcript showCr:'listen ..'.
	connectSock listenFor:5.
	Transcript showCr:'wait'.
	connectSock readWait.  
	Transcript showCr:'accept'.
	sock := Socket new acceptOn:self.
	Transcript showCr:'close'.
	connectSock close.
	sock buffered:false.
	Transcript showCr:'server: got it'.
	'can now do transfer via sock'.
	Transcript showCr:'read'.
	Transcript showCr:('got: ' , sock nextLine).
	sock close

    example (connect to above server and send some data):

	|sock|

	sock := Socket connectTo:9996 on:'porty'.
	sock buffered:false.
	Transcript showCr:'client: got it'.
	'can now do transfer via sock'.
	Transcript showCr:'sending <hello>'.
	sock nextPutLine:'hello'.
	sock close
"
! !

!Socket primitiveDefinitions!

%{
#include <stdio.h>
#include <errno.h>

#ifdef LINUX
/* kludge to avoid some redefines ... */
# define _ARPA_NAMESER_H
# define _NETINET_TCP_H
#endif

#ifndef transputer
# include <fcntl.h>
# include <sys/types.h>
# ifdef IRIS
   /* no socket.h on 4.0.5h ?!?!? */
#  define AF_UNIX 1
#  define AF_INET 2
#  define SOCK_STREAM 1
#  define SOCK_DGRAM  2
#  define SOCK_RAW    3
# else
#  include <sys/socket.h>
# endif
# include <netdb.h>
# include <netinet/in.h>
# if ! (defined(SYSV3) && defined(mc88k))
#  include <netinet/tcp.h>
# endif
#endif

extern int __immediateInterrupt__;
/*
 * on some systems errno is a macro ... check for it here
 */
#ifndef errno
 extern errno;
#endif

%}
! !

!Socket class methodsFor:'signal access'!

brokenConnectionSignal
    "return the signal used to tell broken connections.
     Since in unix, this is the same as the broken pipe signal,
     return that one.
     (for other Operatingsystems, this may change ..)"

    ^ PipeStream brokenPipeSignal
! !

!Socket class methodsFor:'queries'!

ipAddressOfHost:aHostName
    "return the IP (internet-) number for a hostname"

    |b1 b2 b3 b4|

%{
    struct sockaddr_in sa ;
    struct hostent *hp ;
    long addr;

    if (__isString(aHostName)) {
	bzero(&sa, sizeof(sa)) ;
	if ((addr = inet_addr((char *) _stringVal(aHostName))) != -1) {
	    /* is Internet addr in octet notation */
	    bcopy(&addr, (char *) &sa.sin_addr, sizeof(addr)); 
	    sa.sin_family = AF_INET;
	} else {
	    /* do we know the host's address? */
	    if ((hp = gethostbyname((char *) _stringVal(aHostName))) == NULL) {
		printf("unknown host\n");
		RETURN ( nil );
	    }
	    bcopy(hp->h_addr, (char *) &sa.sin_addr, hp->h_length) ;
	    sa.sin_family = hp->h_addrtype;
	}
    }
    /* if the addressing family is not AF_INET, return nil */
    if (sa.sin_family != AF_INET) {
	RETURN ( nil );
    }
    b1 = _MKSMALLINT((sa.sin_addr.s_addr >> 24) & 0xFF);
    b2 = _MKSMALLINT((sa.sin_addr.s_addr >> 16) & 0xFF);
    b3 = _MKSMALLINT((sa.sin_addr.s_addr >> 8) & 0xFF);
    b4 = _MKSMALLINT((sa.sin_addr.s_addr >> 0) & 0xFF);
%}
.
    ^ ByteArray with:b1 with:b2 with:b3 with:b4

    "Socket ipAddressOfHost:'clam'"
    "Socket ipAddressOfHost:'porty'"
    "Socket ipAddressOfHost:'josef'"
!

hostWithIpAddress:anAddress
    "return the hostname for an IP (internet-) address"

    |b1 b2 b3 b4|

    b1 := anAddress at:1.
    b2 := anAddress at:2.
    b3 := anAddress at:3.
    b4 := anAddress at:4.
%{
    struct sockaddr_in sa ;
    struct hostent *hp ;

    if (__bothSmallInteger(b1, b2) && __bothSmallInteger(b3, b4)) {
	bzero(&sa, sizeof(sa)) ;
	sa.sin_addr.s_addr = _intVal(b1) & 0xFF;
	sa.sin_addr.s_addr = (sa.sin_addr.s_addr << 8) | (_intVal(b2) & 0xFF);
	sa.sin_addr.s_addr = (sa.sin_addr.s_addr << 8) | (_intVal(b3) & 0xFF);
	sa.sin_addr.s_addr = (sa.sin_addr.s_addr << 8) | (_intVal(b4) & 0xFF);
	sa.sin_family = AF_INET;
	/* do we know the host's address? */
	hp = gethostbyaddr((char *) &sa.sin_addr.s_addr, sizeof(sa.sin_addr.s_addr), AF_INET);
	if (hp == NULL) {
	    printf("unknown address: %d.%d.%d.%d\n", _intVal(b1), _intVal(b2), _intVal(b3), _intVal(b4));
	}
	sa.sin_family = hp->h_addrtype;
    }

    /* if the addressing family is not AF_INET, return nil */
    if (sa.sin_family != AF_INET) {
	RETURN ( nil );
    }
    if (hp != NULL)
	RETURN (_MKSTRING(hp->h_name COMMA_CON));

    RETURN (_MKSTRING(inet_ntoa(sa.sin_addr) COMMA_CON));
%}

    "
     Socket ipAddressOfHost:'clam'
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'clam')
     Socket ipAddressOfHost:'porty'
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'porty')
     Socket hostWithIpAddress:#[1 2 3 4]
    "
!

portOfService:aNameOrNumber
    "returns the port-number for a given service
     or nil if no such service exists;
     - used to convert service names to portNumbers"
%{
    struct servent *servent = NULL;

    if (__isSmallInteger(aNameOrNumber)) {
	servent = getservbyport(htons(_intVal(aNameOrNumber)), "tcp") ;
	if (servent != NULL) {
	    RETURN ( aNameOrNumber );
	}
	RETURN ( aNameOrNumber );
    }
    if (__isString(aNameOrNumber)) {
	servent = getservbyname((char *) _stringVal(aNameOrNumber), "tcp");
	if (servent != NULL) {
	    RETURN ( _MKSMALLINT(ntohs(servent->s_port)) );
	}
	RETURN ( nil );
    }
    RETURN ( nil );
%}
    "
     Socket portOfService:'finger'
     Socket portOfService:'nntp'
     Socket portOfService:'echo'
    "
!

protocolOfService:aNameOrNumber
    "returns the protocol (as string) for a given service
     or nil if no such service exists."
%{
    struct servent *servent = NULL;

    if (__isSmallInteger(aNameOrNumber)) {
	servent = getservbyport(htons(_intVal(aNameOrNumber)), "tcp") ;
	if (servent == NULL) {
	    servent = getservbyport(htons(_intVal(aNameOrNumber)), "udp") ;
	    if (servent == NULL) {
		RETURN ( nil );
	    }
	}
    } else {
	if (__isString(aNameOrNumber)) {
	    servent = getservbyname((char *) _stringVal(aNameOrNumber), "tcp");
	    if (servent == NULL) {
		servent = getservbyname((char *) _stringVal(aNameOrNumber), "udp");
		if (servent == NULL) {
		    RETURN ( nil );
		}
	    }
	}
    }
    if (servent) {
	RETURN ( _MKSTRING(servent->s_proto COMMA_CON) );
    }
    RETURN ( nil );
%}
    "
     Socket protocolOfService:'finger'
     Socket protocolOfService:'nntp'
     Socket protocolOfService:'xxx'
     Socket protocolOfService:79
    "
!

domainOfProtocol:aProtocol
    "given a protocols name (i.e. tcp, udp etc) return the domain.
     This method needs more ... - or is there a way to get this from the system ?"

    "
     tcp/ip stuff
    "
    (aProtocol = 'tcp') ifTrue:[^ #inet].
    (aProtocol = 'udp') ifTrue:[^ #inet].
    (aProtocol = 'ip')  ifTrue:[^ #inet].
    "
     x25 stuff (if any)
     appletalk stuff (if any)
     other stuff (if any)
    "
    ^ nil

    "
     Socket domainOfProtocol:'tcp'
     Socket domainOfProtocol:'ucp'
     Socket domainOfProtocol:(Socket protocolOfService:'nntp')
     Socket domainOfProtocol:(Socket protocolOfService:'echo')
    "
!

typeOfProtocol:aProtocol
    "given a protocols name (i.e. tcp, udp etc) return the connection type.
     This method needs more ... - or is there a way to get this from the system ?"

    (aProtocol = 'tcp') ifTrue:[^ #stream].
    (aProtocol = 'udp') ifTrue:[^ #datagram].
    (aProtocol = 'ip')  ifTrue:[^ #raw].
    "
     x25 stuff (if any)
     appletalk stuff (if any)
     other stuff (if any)
    "
    ^ nil

    "
     Socket typeOfProtocol:'tcp'
     Socket typeOfProtocol:'ucp'
     Socket typeOfProtocol:(Socket protocolOfService:'nntp')
     Socket typeOfProtocol:(Socket protocolOfService:'echo')
    "
! !

!Socket class methodsFor:'tcp/ip instance creation'!

connectTo:service on:host
    "standard setup: create new client tcp socket, bind and connect; 
     return the socket.
     The system will block (interruptable), until the connection is 
     established."

    ^ (self new) for:host port:(self portOfService:service).

    "
     Socket connectTo:9995 on:'clam'
     Socket connectTo:'finger' on:'clam'
     Socket connectTo:'nntp' on:(OperatingSystem getEnvironment:'NNTPSERVER')
    "
!

provide:service
    "standard setup: create a new TCP server socket providing a service."

    |newSock|

    newSock := (self new) for:nil port:(self portOfService:service).
    newSock notNil ifTrue:[
	newSock listenFor:5.
    ].
    ^ newSock

    "
     Socket provide:9995
     (Socket provide:9996) accept
     Socket provide:'nntp'
    "
! !

!Socket class methodsFor:'general instance creation'!

domain:domainSymbol type:type
    "create a socket for domain and type -
     neither any connect nor binding is done.
     Domain must be one of the symbols: #inet, #unix, #ns, #appletalk or #ns;
     Type must be #stream, #datagram or #raw

     XXX: currently only the #inet domain is supported"

    ^ self new domain:domainSymbol type:type

    "Socket domain:#inet type:#stream"
    "Socket domain:#inet type:#datagram"
    "Socket domain:#appletalk type:#stream"
    "Socket domain:#DECnet type:#stream"
!

newUDP
    "create a UDP socket - no binding or other setup is done,
     neither connect nor connect-wait is done."

    ^ self new domain:#inet type:#datagram

    "Socket newUDP"
!

newUDP:aServiceOrNil
    "create a UDP socket for a service -
     neither connect nor connect-wait is done."

    |newSock|

    newSock := self newUDP.
    (newSock notNil and:[aServiceOrNil notNil]) ifTrue:[
	newSock bindTo:(self portOfService:aServiceOrNil) address:nil
    ].
    ^ newSock

    "Socket newUDP:nil"
!

newTCP
    "create a TCP socket - no binding or other setup is done,
     neither connect nor connect-wait is done."

    ^ self new domain:#inet type:#stream 

    "Socket newUDP"
!

newTCP:aServiceOrNil
    "create a TCP socket for a service -
     neither connect nor connect-wait is done."

    |newSock|

    newSock := self newTCP.
    (newSock notNil and:[aServiceOrNil notNil]) ifTrue:[
	newSock bindTo:(self portOfService:aServiceOrNil) address:nil
    ].
    ^ newSock


    "Socket newTCP:'nntp'"
    "Socket newTCP:9995"
!

newTCPclientToHost:hostname port:aService
    "create a new TCP client socket connecting to a service."

    |newSock|

    newSock := self newTCP.
    newSock notNil ifTrue:[
	(newSock connectTo:hostname port:(self portOfService:aService)) ifFalse:[
	    ^ nil
	]
    ].
    ^ newSock
"
same as:
    ^ (self new) for:hostname port:(self portOfService:aPort).
"
    "

      Socket newTCPclientToHost:'slsv6bt' port:'nntp'
    "
!

newTCPserverAtPort:aService
    "create a new TCP server socket providing service."

    |newSock|

    newSock := self newTCP.
    newSock notNil ifTrue:[
	(newSock bindTo:(self portOfService:aService) address:nil) ifFalse:[
	    ^ nil
	]
    ].
    ^ newSock
"
same as:
    ^ (self new) for:nil port:aPort
"
!

newUDPserverAtPort:aService
    "create a new UDP server socket providing service."

    |newSock|

    newSock := self newUDP.
    newSock notNil ifTrue:[
	(newSock bindTo:(self portOfService:aService) address:nil) ifFalse:[
	    ^ nil
	]
    ].
    ^ newSock
"
same as:
    ^ (self new) for:nil udpPort:aPort
"
! !

!Socket methodsFor:'socket setup'!

domain:domainArg type:typeArg
    "set up socket with domain, type.
     This is a low level entry; no binding, listening or connect
     is done."

    |errorNr|

    filePointer notNil ifTrue:[
	^ self error:'already created'
    ].
%{
    FILE *fp;
    int dom, typ, proto, sock;

    if (! __isSymbol(domainArg)) { 
	fprintf(stderr, "bad domain\n");
	RETURN ( nil );
    }
    if (! __isSymbol(typeArg)) { 
	fprintf(stderr, "bad type\n");
	RETURN ( nil );
    }

    /*
     * get address-family
     */
#ifdef AF_UNIX
    if (domainArg == @symbol(unix))
	dom = AF_UNIX;
    else
#endif
#ifdef AF_INET
    if (domainArg == @symbol(inet))
	dom = AF_INET;
    else
#endif
#ifdef AF_NS
    if (domainArg == @symbol(ns))
	dom = AF_NS;
    else
#endif
#ifdef AF_DECnet
    if (domainArg == @symbol(DECnet))
	dom = AF_DECnet;
    else
#endif
#ifdef AF_APPLETALK
    if (domainArg == @symbol(appletalk))
	dom = AF_APPLETALK;
    else
#endif
#ifdef AF_X25
    if (domainArg == @symbol(x25))
	dom = AF_X25;
    else
#endif
    {
	fprintf(stderr, "unknown domain <%s>\n", _stringVal(domainArg));
	RETURN ( nil );
    }

#ifdef SOCK_STREAM
    if (typeArg == @symbol(stream))
	typ = SOCK_STREAM;
    else
#endif
#ifdef SOCK_DGRAM
    if (typeArg == @symbol(datagram))
	typ = SOCK_DGRAM;
    else 
#endif
#ifdef SOCK_RAW
    if (typeArg == @symbol(raw))
	typ = SOCK_RAW;
    else
#endif
#ifdef SOCK_SEQPACKET
    if (typeArg == @symbol(seqPacket))
	typ = SOCK_SEQPACKET;
    else
#endif
    {
	fprintf(stderr, "bad type <%s>\n", _stringVal(typeArg));
	RETURN ( nil );
    }

    __immediateInterrupt__ = 1;
    do {
	sock = socket(dom, typ, 0);
    } while ((sock < 0) && (errno == EINTR));
    __immediateInterrupt__ = 0;

    if (sock < 0) {
	fprintf(stderr, "socket failed\n");
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
    } else {
	/* 
	 * make it a FILE * 
	 */
	fp = fdopen(sock, "r+");
	if (! fp) {
	    fprintf(stderr, "fdopen failed\n");
	    _INST(lastErrorNumber) = _MKSMALLINT(errno);
	} else {
	    _INST(filePointer) = MKOBJ(fp);
	}
    }
%}
.
    "all ok?"
    filePointer notNil ifTrue:[
	domain := domainArg.
	socketType := typeArg.
    ] ifFalse:[
	^ nil
    ].

    "
     Socket new domain:#inet type:#stream
    "
!

for:hostName udpPort:portNr
    "setup for a UDP socket (i.e. inet domain, datagram type) 
     if hostname is nil, a server port is opened;
     otherwise a client port to the server on host.

     HISTORIC LEFTOVER:
     This method will vanish, as soon as the low level
     connect/bind works,"

    filePointer notNil ifTrue:[
	^ self error:'already created'
    ].
    (portNr isMemberOf:SmallInteger) ifFalse:[
	^ self error:'invalid portNr'
    ].
%{
    struct sockaddr_in sa ;
    struct hostent *hp ;
    int a, sock ;
    long addr;
    FILE *fp;
    int ret;

    if (hostName != nil) {
	bzero(&sa, sizeof(sa)) ;
	if ((addr = inet_addr((char *) _stringVal(hostName))) != -1) {
	    /* 
	     * is Internet addr in octet notation 
	     */
	    bcopy(&addr, (char *) &sa.sin_addr, sizeof(addr)) ; /* set address */
	    sa.sin_family = AF_INET ;
	} else {
	    /* 
	     * is hostname - 
	     * do we know the host's address? 
	     */
	    if ((hp = gethostbyname((char *) _stringVal(hostName))) == NULL) {
		printf("unknown host\n");
		RETURN ( nil );
	    }
	    bcopy(hp->h_addr, (char *) &sa.sin_addr, hp->h_length) ;
	    sa.sin_family = hp->h_addrtype ;
	}
    } else
	sa.sin_family = AF_INET;

    /*
     * create the socket
     */
    __immediateInterrupt__ = 1;
    do {
	sock = socket(sa.sin_family, SOCK_DGRAM, 0);
    } while ((sock < 0) && (errno == EINTR));
    if (sock < 0) {
	fprintf(stderr, "socket failed\n");
	__immediateInterrupt__ = 0;
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
    } else {
	/* 
	 * ok,
	 * connect/bind 
	 */
	if (hostName == nil) {
	    sa.sin_addr.s_addr = htonl(INADDR_ANY);
	    do {
		ret = bind(sock, (struct sockaddr *)&sa, sizeof(sa));
	    } while ((ret < 0) && (errno == EINTR));
	} else {
	    sa.sin_port = htons((u_short) _intVal(portNr)) ;
	    do {
		ret = connect(sock, (struct sockaddr *)&sa, sizeof(sa));
	    } while ((ret < 0) && (errno == EINTR));
	}
	__immediateInterrupt__ = 0;

	if (ret < 0) {
	    fprintf(stderr, "bind/connect failed\n");
	    _INST(lastErrorNumber) = _MKSMALLINT(errno);
	    close(sock) ;
	} else {
	    /* 
	     * make it a FILE * 
	     */
	    fp = fdopen(sock, "r+");
	    if (! fp) {
		fprintf(stderr, "fdopen failed\n");
		_INST(lastErrorNumber) = _MKSMALLINT(errno);
		close(sock);
	    } else {
/*
		setbuf(fp, NULL);
 */
		_INST(filePointer) = MKOBJ(fp);
	    }
	}
    }
%}.
    filePointer isNil ifTrue:[
	^ nil
    ].

"
    buffered := false.
"
    mode := #readwrite.
    binary := false.

    domain := #inet.
    socketType := #datagram.
    protocol := portNr.

    "
     Socket new for:'clam' udpPort:(Socket portOfService:'echo')
    "
!

for:hostName port:portNr
    "setup for a TCP socket (i.e. inet domain, stream type) 
     If hostname is nil, a server port is opened,
     otherwise a client port to the server on host.

     HISTORIC LEFTOVER:
     This method will vanish, as soon as the low level
     connect/bind works,"

    filePointer notNil ifTrue:[
	^ self error:'already created'
    ].
    (portNr isMemberOf:SmallInteger) ifFalse:[
	^ self error:'invalid portNr'
    ].
%{
    struct sockaddr_in sa ;
    struct hostent *hp ;
    int a, sock ;
    long addr;
    FILE *fp;
    int ret;
    int on = 1;

    bzero((char *) &sa, sizeof(sa)) ;
    sa.sin_family = AF_INET;
    sa.sin_addr.s_addr = htonl(INADDR_ANY);

    if ((hostName != nil) && __isString(hostName)){
	bzero(&sa, sizeof(sa)) ;
	if ((addr = inet_addr((char *) _stringVal(hostName))) != -1) {
	    /* 
	     * is Internet addr in octet notation 
	     */
	    bcopy(&addr, (char *) &sa.sin_addr, sizeof(addr)) ; /* set address */
	} else {
	    /* 
	     * do we know the host's address? 
	     */
	    if ((hp = gethostbyname((char *) _stringVal(hostName))) == NULL) {
		fprintf(stderr, "unknown host\n");
		RETURN ( nil );
	    }
	    bcopy(hp->h_addr, (char *) &sa.sin_addr, hp->h_length) ;
	    sa.sin_family = hp->h_addrtype;
	}
    }

    /*
     * create the socket
     */
    __immediateInterrupt__ = 1;
    do {
	sock = socket(sa.sin_family, SOCK_STREAM, 0);
    } while ((sock < 0) && (errno == EINTR));

    if (sock < 0) {
	fprintf(stderr, "socket failed\n");
	__immediateInterrupt__ = 0;
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
    } else {
	/* 
	 * connect/bind 
	 */
	sa.sin_port = htons((u_short) _intVal(portNr)) ;
	if (hostName != nil) {
	    do {
		ret = connect(sock, (struct sockaddr *)&sa, sizeof(sa));
	    } while ((ret < 0) && (errno == EINTR));
	} else {
#ifdef SO_REUSEADDR
	    /*
	     * should I also do this for DGRAM sockets ?
	     */
	    if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &on, sizeof (on)) < 0) {
		printf("setsockopt - SO_REUSEADDR failed\n");
	    }
#endif /* SO_REUSEADDR */
	    sa.sin_addr.s_addr = htonl(INADDR_ANY);
	    do {
		ret = bind(sock, (struct sockaddr *)&sa, sizeof(sa));
	    } while ((ret < 0) && (errno == EINTR));
	}
	__immediateInterrupt__ = 0;

	if (ret < 0) { 
	    fprintf(stderr, "bind/connect failed\n");
	    _INST(lastErrorNumber) = _MKSMALLINT(errno);
	    close(sock) ;
	} else {
	    /* 
	     * make it a FILE * 
	     */
	    fp = fdopen(sock, "r+");
	    if (! fp) {
		fprintf(stderr, "fdopen failed\n");
		_INST(lastErrorNumber) = _MKSMALLINT(errno);
		close(sock);
	    } else {
/*
		setbuf(fp, NULL);
*/
		_INST(filePointer) = MKOBJ(fp);
	    }
	}
    }
%}.
    filePointer isNil ifTrue:[
	^ nil
    ].
"
    buffered := false.
"
    mode := #readwrite.
    binary := false.

    domain := #inet.
    socketType := #stream.
    protocol := portNr.

    "
     Socket new for:'clam' port:(Socket portOfService:'echo')
    "
! !

!Socket methodsFor:'low level'!

closeFile
    "low level close"

%{  /* NOCONTEXT */

    OBJ t;

    t = _INST(filePointer);
    if (t != nil) {
	FILE *fp;

	fp = MKFD(t);
	fflush(fp);
	shutdown(fileno(fp), 2);
	fclose(fp);
	_INST(filePointer) = nil;
    }
%}
!

bindTo:portNumber address:address
    "low level bind - returns true if ok, false otherwise.
     (currently only non-address binding is supported; i.e. address
      must be nil)"

    filePointer isNil ifTrue:[
	^ self error:'not a valid socket'
    ].
%{
    OBJ t = _INST(filePointer);
    int sock;
    struct sockaddr_in insock;
    int ret;
    int on = 1;
    int ok;

    if (!__isString(_INST(domain)) && !__isSymbol(_INST(domain))) {
	fprintf(stderr, "invalid domain\n");
	RETURN (false);
    }

    ok = 0;
#ifdef AF_INET
    if (_INST(domain) == @symbol(inet)) {
	/*
	 * INET addresses - port must be a smallinteger
	 */
	insock.sin_family = AF_INET;
	if (! __isSmallInteger(portNumber)) {
	    fprintf(stderr, "invalid port\n");
	    RETURN (false);
	}
	insock.sin_port = htons(_intVal(portNumber));
	if (address == nil) {
	    insock.sin_addr.s_addr = htonl(INADDR_ANY);
	    ok = 1;
	} else {
	    fprintf(stderr, "address bind not supported\n");
	    RETURN (false);
	}
    }
#endif
    /*
     * XXXX add addressing stuff for other domains here ...
     */
#ifdef AF_UNIX
    if (_INST(domain) == @symbol(unix)) {
    }
#endif
#ifdef AF_X25
    if (_INST(domain) == @symbol(x25)) {
    }
#endif
#ifdef AF_NS
    if (_INST(domain) == @symbol(ns)) {
    }
#endif
#ifdef AF_APPLETALK
    if (_INST(domain) == @symbol(appletalk)) {
    }
#endif

    if (! ok) {
	fprintf(stderr, "unsupported domain\n");
	RETURN (false);
    }

    sock = fileno(MKFD(t));

#ifdef SO_REUSEADDR
    if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &on, sizeof (on)) < 0) {
	fprintf(stderr, "setsockopt - SO_REUSEADDR failed\n");
    }
#endif /* SO_REUSEADDR */

    do {
	ret = bind(sock, (struct sockaddr *)&insock, sizeof(insock));
    } while ((ret < 0) && (errno == EINTR));

    if (ret < 0) {
	fprintf(stderr, "bind failed\n");
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	RETURN (false);
    }
%}.

    portNr := portNumber.
    ^ true

    "
     (Socket domain:#inet type:#stream)
	 bindTo:9999
	 address:nil
    "
!

connectTo:hostName port:aPortNr
    "low level connect; connect to port, aPortNr on host, hostName.
     Return true if ok, false otherwise."

    filePointer isNil ifTrue:[
	^ self error:'not a valid socket'
    ].
%{
    OBJ t = _INST(filePointer);
    struct sockaddr_in sa ;
    struct hostent *hp ;
    int a, sock ;
    long addr;
    FILE *fp;
    int ret;
    int on = 1;
    int ok;

    if (! __isString(hostName)) {
	fprintf(stderr, "invalid hostname\n");
	RETURN (false);
    }
    if (!__isString(_INST(domain)) && !__isSymbol(_INST(domain))) {
	fprintf(stderr, "invalid domain\n");
	RETURN (false);
    }

    ok = 0;
#ifdef AF_INET
    if (_INST(domain) == @symbol(inet)) {
	if (! __isSmallInteger(aPortNr)) {
	    fprintf(stderr, "invalid port\n");
	    RETURN (false);
	}

	bzero((char *) &sa, sizeof(sa)) ;
	sa.sin_family = AF_INET;
	sa.sin_port = htons((u_short) _intVal(aPortNr)) ;

	if ((addr = inet_addr((char *) _stringVal(hostName))) != -1) {
	    /* 
	     * is Internet addr in octet notation 
	     */
	    bcopy(&addr, (char *) &sa.sin_addr, sizeof(addr)) ; /* set address */
	    ok = 1;
	} else {
	    /* 
	     * do we know the host's address? 
	     */
	    if ((hp = gethostbyname((char *) _stringVal(hostName))) == NULL) {
		fprintf(stderr, "unknown host:%s\n", _stringVal(hostName));
		RETURN (false);
	    }
	    bcopy(hp->h_addr, (char *) &sa.sin_addr, hp->h_length) ;
	    sa.sin_family = hp->h_addrtype;
	    ok = 1;
	}
    }
#endif
    /*
     * XXXX add addressing stuff for other domains here ...
     */
#ifdef AF_UNIX
    if (_INST(domain) == @symbol(unix)) {
    }
#endif
#ifdef AF_X25
    if (_INST(domain) == @symbol(x25)) {
    }
#endif
#ifdef AF_NS
    if (_INST(domain) == @symbol(ns)) {
    }
#endif
#ifdef AF_APPLETALK
    if (_INST(domain) == @symbol(appletalk)) {
    }
#endif

    if (! ok) {
	fprintf(stderr, "unsupported domain\n");
	RETURN (false);
    }

    sock = fileno(MKFD(t));

    /* 
     * connect 
     */
    __immediateInterrupt__ = 1;

    do {
	ret = connect(sock, (struct sockaddr *)&sa, sizeof(sa));
    } while ((ret < 0) && (errno == EINTR));
    __immediateInterrupt__ = 0;

    if (ret < 0) { 
	fprintf(stderr, "connect failed\n");
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	RETURN (false);
    }
%}.
    portNr := aPortNr.
    ^ true
!

listenWithBacklog:aNumber
    "start listening; return true if ok, false on error"

    filePointer isNil ifTrue:[
	^ self error:'not a valid socket'
    ].
%{
    OBJ fp = _INST(filePointer);
    int sock;
    int ret;

    if (! __isSmallInteger(aNumber)) {
	fprintf(stderr, "invalid arg\n");
	RETURN (false);
    }

    sock = fileno(MKFD(fp));

    __immediateInterrupt__ = 1;
    do {
	ret = listen(sock, _intVal(aNumber));
    } while ((ret < 0) && (errno == EINTR));
    __immediateInterrupt__ = 0;

    if (ret < 0) {
	fprintf(stderr, "listen failed\n");
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	RETURN (false);
    }
%}.
    ^ true
!

listenFor:aNumber
    "same as listenWithBacklog: - for ST-80 compatibility"

    ^ self listenWithBacklog:aNumber
!

acceptOn:aSocket
    "accept a connection on a server port (created with:'Socket>>onIPPort:')
     usage is: (Socket basicNew acceptOn:(Socket onIPPort:9999)).
     Return the true if ok; false if not.

     NOTICE: this method will block, if no connection is already pending.
	     use readWait or Socket>>accept."

    |serverSocketFd|

    filePointer notNil ifTrue:[
	^ self error:'already connected'
    ].

    domain := aSocket domain.
    socketType := aSocket type.
    serverSocketFd := aSocket fileDescriptor.
    serverSocketFd isNil ifTrue:[
	^ self error:'invalid server socket'
    ].
    (serverSocketFd isMemberOf:SmallInteger) ifFalse:[
	^ self error:'invalid server socket'
    ].
%{
    FILE *fp;
    int flags;
    int sock, newSock;
    struct sockaddr_in sa ;
    int alen;
    struct hostent *he ;
    long norder ;
    char dotted[20] ;

    alen = sizeof(sa) ;
    sock = _intVal(serverSocketFd);

    flags = ioctl(sock, F_GETFL, 0);
    ioctl(sock, F_SETFL, flags | O_NDELAY);
    __immediateInterrupt__ = 1;
    do {
	newSock = accept(sock, (struct sockaddr *) &sa, &alen);
    } while ((newSock < 0) && (errno == EINTR));
    __immediateInterrupt__ = 0;

    if (newSock < 0) {
	fprintf(stderr, "accept failed\n");
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	RETURN (false);
    }

    /*
     * extract the partners address
     */
#ifdef AF_INET
    if (_INST(domain) == @symbol(inet)) {
	he = gethostbyaddr((char *) &sa.sin_addr.s_addr, alen, AF_INET) ;
	if (! he) {
	    norder = htonl(sa.sin_addr.s_addr) ;
	    sprintf(dotted, "%d.%d.%d.%d",
# if defined(SYSV3) || defined(LINUX) || defined(IRIS) || defined(IRIX5)
		    (norder >> 24) & 0xFF,
		    (norder >> 16) & 0xFF,
		    (norder >> 8) & 0xFF,
		    norder & 0xFF);
# else
		    sa.sin_addr.s_net, sa.sin_addr.s_host,
		    sa.sin_addr.s_lh, sa.sin_addr.s_impno);
# endif
	}
	fprintf(stderr, "accepted connection from host %s\n", (he ? he->h_name : dotted)) ;
	_INST(peerName) = _MKSTRING((he ? he->h_name : dotted) COMMA_CON);
    }
#endif

    /* 
     * make it a FILE * 
     */
    fp = fdopen(newSock, "r+");
    if (! fp) {
	fprintf(stderr, "fdopen failed\n");
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	close(newSock);
	RETURN (false);
    } else {
/*
	setbuf(fp, NULL);
*/
	_INST(filePointer) = MKOBJ(fp);
    }
%}.
"
    buffered := false.
"
    mode := #readwrite.
    binary := false.
    portNr := aSocket portNumber.
    ^ true
!

accept
    "create a new TCP socket from accepting on the receiver.
     This method will suspend the current process if no connection is waiting.
     For ST-80 compatibility"

    |newSock|

    self readWait.  
    newSock := self class new.
    (newSock acceptOn:self) ifFalse:[^ nil].
    ^ newSock

    "
     |sock newSock|

     sock := Socket provide:8004.
     sock listenFor:5.
     newSock := sock accept.
    "
! !

!Socket methodsFor:'queries'!

getPeerName
    "return the peer name; thats the hostname (or dotted name) of the
     partners host after an accept."

    ^ peerName
!

portNumber
    "return the port number to which the socket is bound"

    ^ portNr
!

domain
    "return the sockets addressing domain (i.e. #inet, #x25, #appletalk)"

    ^ domain
!

type
    "return the sockets connection type (i.e. #datagram, #stream etc)"

    ^ socketType
! !

!Socket methodsFor:'specials'!

sendTimeout:seconds
    "set the send timeout - for special applications only"

    |millis|

    filePointer isNil ifTrue:[
	^ self error:'not a valid socket'
    ].
    millis := (seconds * 1000) rounded.
%{
#if defined(SO_SNDTIMEO) && defined(SOL_SOCKET) && defined(HZ)
    if (__isSmallInteger(millis)) {
	OBJ fp = _INST(filePointer);
	int sock;
	int opt;

	sock = fileno(MKFD(fp));
	opt = _intVal(millis) / (1000 / HZ);
	setsockopt(sock, SOL_SOCKET, SO_SNDTIMEO, (char *)&opt, sizeof(int));
	RETURN(true);
    }
#endif
%}
.
    ^ false
!

receiveTimeout:seconds
    "set the send timeout - for special applications only"

    |millis|

    filePointer isNil ifTrue:[
	^ self error:'not a valid socket'
    ].
    millis := (seconds * 1000) rounded.
%{
#if defined(SO_RCVTIMEO) && defined(SOL_SOCKET) && defined(HZ)
    if (__isSmallInteger(millis)) {
	OBJ fp = _INST(filePointer);
	int sock;
	int opt;

	sock = fileno(MKFD(fp));
	opt = _intVal(millis) / (1000 / HZ);
	setsockopt(sock, SOL_SOCKET, SO_RCVTIMEO, (char *)&opt, sizeof(int));
	RETURN(true);
    }
#endif
%}
.
    ^ false
! !

!Socket methodsFor:'datagram transmission'!

receiveFrom:anAddressBuffer buffer:aDataBuffer
    "receiver data - put address of originating host into
     anAddressBuffer, data into aBuffer. Both must be
     ByteArray-like.
     Return the number of bytes received."

%{
    OBJ oClass;
    OBJ fp = _INST(filePointer);
    int nInstVars, nInstBytes, objSize;
    int sock;
    struct sockaddr_in sa ;
    int alen;
    int n;
    char *cp;
    int flags = 0;

    if (fp != nil) {
	sock = fileno((FILE *)(_intVal(fp)));

	oClass = _Class(aDataBuffer);
	switch (_intVal(_ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
	    case BYTEARRAY:
	    case WORDARRAY:
	    case LONGARRAY:
	    case FLOATARRAY:
	    case DOUBLEARRAY:
		break;
	    default:
		goto bad;
	}
	nInstVars = _intVal(_ClassInstPtr(oClass)->c_ninstvars);
	nInstBytes = OHDR_SIZE + nInstVars * sizeof(OBJ);
	objSize = _Size(aDataBuffer) - nInstBytes;
	cp = (char *)_InstPtr(aDataBuffer) + nInstBytes;

	if (anAddressBuffer == nil) {
	    n = recvfrom(sock, cp, objSize, flags, (struct sockaddr *) 0, 0);
	} else {
	    n = recvfrom(sock, cp, objSize, flags, (struct sockaddr *) &sa, &alen);
	    if (n >= 0) {
		oClass = _Class(anAddressBuffer);
		if ((_intVal(_ClassInstPtr(oClass)->c_flags) & ARRAYMASK) == BYTEARRAY) {
		    nInstVars = _intVal(_ClassInstPtr(oClass)->c_ninstvars);
		    nInstBytes = OHDR_SIZE + nInstVars * sizeof(OBJ);
		    objSize = _Size(anAddressBuffer) - nInstBytes;
		    cp = (char *)_InstPtr(anAddressBuffer) + nInstBytes;
		    if (objSize >= alen) {
			bcopy((char *)&sa, cp, alen);
		    }
		}
	    }
	}
	if (n >= 0) {
	    RETURN (_MKSMALLINT(n));
	}
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	RETURN (_MKSMALLINT(-1));
    }
bad: ;
%}.
    "
     arrive here if you try to receive into an invalid buffer
     (i.e. not ByteArray-like)
    "
    self primitiveFailed
!

sendTo:anAddressBuffer buffer:aDataBuffer
    "send data - get address of destination host from
     anAddressBuffer, data from aDataBuffer. 
     Both must be ByteArray-like."

%{
    OBJ oClass;
    OBJ fp = _INST(filePointer);
    int nInstVars, nInstBytes, objSize;
    int sock;
    struct sockaddr_in sa ;
    int alen = sizeof(sa);
    int n;
    char *cp;
    int flags = 0;

    if (fp != nil) {
	sock = fileno((FILE *)(_intVal(fp)));

	oClass = _Class(anAddressBuffer);
	if ((_intVal(_ClassInstPtr(oClass)->c_flags) & ARRAYMASK) == BYTEARRAY) {
	    nInstVars = _intVal(_ClassInstPtr(oClass)->c_ninstvars);
	    nInstBytes = OHDR_SIZE + nInstVars * sizeof(OBJ);
	    objSize = _Size(anAddressBuffer) - nInstBytes;
	    cp = (char *)_InstPtr(anAddressBuffer) + nInstBytes;
	    if (objSize <= alen) {
		bcopy(cp, (char *)&sa, objSize);
		alen = objSize;
	    }
	}

	oClass = _Class(aDataBuffer);
	switch (_intVal(_ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
	    case BYTEARRAY:
	    case WORDARRAY:
	    case LONGARRAY:
	    case FLOATARRAY:
	    case DOUBLEARRAY:
		break;
	    default:
		goto bad;
	}
	nInstVars = _intVal(_ClassInstPtr(oClass)->c_ninstvars);
	nInstBytes = OHDR_SIZE + nInstVars * sizeof(OBJ);
	objSize = _Size(aDataBuffer) - nInstBytes;
	cp = (char *)_InstPtr(aDataBuffer) + nInstBytes;

	if (anAddressBuffer == nil) {
	    n = sendto(sock, cp, objSize, flags, (struct sockaddr *) 0, 0);
	} else {
	    n = sendto(sock, cp, objSize, flags, (struct sockaddr *) &sa, alen);
	}
	if (n >= 0) {
	    RETURN (_MKSMALLINT(n));
	}
	_INST(lastErrorNumber) = _MKSMALLINT(errno);
	RETURN (_MKSMALLINT(-1));
    }
bad: ;
%}.
    self primitiveFailed
! !