Socket.st
author Stefan Vogel <sv@exept.de>
Fri, 28 Mar 2008 13:48:17 +0100
changeset 1937 09fb98759b4a
parent 1935 326f8d31e7ca
child 1938 831af28cc848
permissions -rw-r--r--
Clean up: - inappropriate peer and port settings - method categories

"
 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.
"
"{ Package: 'stx:libbasic2' }"

NonPositionableExternalStream subclass:#Socket
	instanceVariableNames:'domain socketType protocol port serviceName peer peerName
		listening'
	classVariableNames:''
	poolDictionaries:''
	category:'Streams-External'
!

!Socket primitiveDefinitions!
%{

/* #define DGRAM_DEBUG /* */

#include "stxOSDefs.h"

#ifdef WIN32

# undef __BEGIN_INTERRUPTABLE__
# undef __END_INTERRUPTABLE__
# define __BEGIN_INTERRUPTABLE__ ..
# define __END_INTERRUPTABLE__ ..

# define WRAP_STDIO
# define SET_LINGER_WHEN_CREATING_SOCKET

/*
 * mhmh - WIN32-fclose  has a problem in trying to close() the socket
 * instead of closesocket()'ing it
 */
# ifdef WIN32
#  define CLOSESOCKET_AFTER_FCLOSE
#  define xxCLOSESOCKET_BEFORE_FCLOSE
# endif

# define SOCKET_FROM_FD(fd)               (_get_osfhandle(fd))

#else /* not WIN32 */

# define SOCKET_FROM_FD(fd)               (fd)

#endif /* WIN32 */

#define SOCKET_FROM_FILE(f)             (SOCKET_FROM_FD(fileno(f)))
#define SOCKET_FROM_FILE_OBJECT(f)      (SOCKET_FROM_FILE(__FILEVal(f)))

#ifndef WIN32
# define closesocket(sock)    close(sock)
# define SOCKET               int
#endif

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

#ifdef WANT__TCP_DOT_H
# include <netinet/tcp.h>
#endif

#ifdef WANT__NETDB_DOT_H
# include <netdb.h>
#endif

#if defined(TRY_AGAIN) || defined(HOST_NOT_FOUND)
# define USE_H_ERRNO
#endif

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

#ifdef USE_H_ERRNO
# ifndef h_errno
 extern h_errno;
# endif
#endif

#ifdef DEBUG
# define DBGPRINTF(x)    { if (__debugging__) console_printf x; }
# define DBGFPRINTF(x)   { if (__debugging__) console_fprintf x; }
#else
# define DBGPRINTF(x)    /* as nothing */
# define DBGFPRINTF(x)   /* as nothing */
#endif

#ifndef TRUE
# define TRUE   1
#endif
#ifndef FALSE
# define FALSE  0
#endif
#ifndef WIN32
typedef int BOOL;
#endif

#ifdef WIN32
# undef stdout
# undef stderr
# define stdout __win32_stdout()
# define stderr __win32_stderr()
#endif

%}
! !

!Socket primitiveVariables!
%{
static int __debugging__ = 0;
%}
! !

!Socket primitiveFunctions!
%{

static int
setupBufferParameters(aDataBuffer, startIndex, p_extPtr, p_offs, p_objSize)
    OBJ aDataBuffer, startIndex;
    char **p_extPtr;
    int *p_offs;
    int *p_objSize;
{
	char *extPtr = 0;
	int sIdx = 0, objSize = 0, offs = 0;

	sIdx = 0;
	if (__isSmallInteger(startIndex)) {
	    sIdx = __intVal(startIndex) - 1;
	}

	if (__isExternalBytesLike(aDataBuffer)) {
	    OBJ sz;

	    extPtr = (char *)(__externalBytesAddress(aDataBuffer));
	    sz = __externalBytesSize(aDataBuffer);
	    if (__isSmallInteger(sz)) {
		objSize = __intVal(sz);
	    } else {
		objSize = 0; /* unknown */
	    }
	    offs = sIdx;
	} else {
	    OBJ oClass;
	    int nInstVars, nInstBytes;

	    extPtr = (char *)0;
	    oClass = __Class(aDataBuffer);
	    switch (__intVal(__ClassInstPtr(oClass)->c_flags) & ARRAYMASK) {
		case BYTEARRAY:
		    offs = sIdx;
		    break;
		case WORDARRAY:
		case SWORDARRAY:
		    offs = sIdx * 2;
		    break;
		case LONGARRAY:
		case SLONGARRAY:
		    offs = sIdx * 4;
		    break;
		case LONGLONGARRAY:
		case SLONGLONGARRAY:
		    offs = sIdx * 8;
# ifdef __NEED_LONGLONG_ALIGN
		    offs += 4;
# endif
		    break;
		case FLOATARRAY:
		    offs = sIdx * sizeof(float);
		    break;
		case DOUBLEARRAY:
		    offs = sIdx * sizeof(double);
# ifdef __NEED_DOUBLE_ALIGN
		    offs += 4;
# endif
		    break;
		default:
		    *p_objSize = -1;
		    return 0;
	    }
	    nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
	    nInstBytes = OHDR_SIZE + nInstVars * sizeof(OBJ);
	    offs = offs + nInstBytes;
	    objSize = _Size(aDataBuffer) - offs;
	}
	*p_extPtr = extPtr;
	*p_objSize = objSize;
	*p_offs = offs;
	return 1;
}
%}
! !

!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.
"
!

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

    Currently, only IP and UNIX domain sockets are really fully
    tested and supported.
    Code for appletalk is included, but was never tested ...
    More may be added in the future.
    (the code is prepared for things like SNA or decNet;
     however, right now, this code is empty and needs a little work.
     Implementing those is pretty straight forward, once the address
     data structures are known.)

    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 #family:type: or #newTCPxxx and #newUDPxxx interfaces,
    together with the bind/listen and accept calls,
    which are meant to be compatible to ST-80's UnixSocketAccessor interface.

    TODO: cleanup historic leftovers, implement other than inet domain stuff.
	  (mhmh - how can I test those ?)
	  change to raise more signals on errors.
	  Help - could someone who has a linux machine connected to an appletalk
		 net please test this (and send bug fixes ...)

    [author:]
	Claus Gittinger
"
!

examples
"
    example (get help info from an nntp server):
									[exBegin]
	|sock host|

	host := OperatingSystem getEnvironment:'NNTPSERVER'.

	sock := Socket newTCPclientToHost:host 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
									[exEnd]


    example (connect to finger daemon, get users entry):
									[exBegin]
	|sock host entry|

	host := OperatingSystem getHostName.

	sock := Socket newTCPclientToHost:host port:'finger'.
	sock isNil ifTrue:[
	    self warn:'no finger daemon is running'.
	    ^ self
	].
	sock useCRLF:true.
	sock buffered:false.
	sock isNil ifTrue:[
	    Transcript showCR:'cannot connect to local finger daemon'
	] ifFalse:[
	    sock nextPutAll:(OperatingSystem getLoginName).
	    sock cr.

	    entry := sock nextLine.
	    Transcript showCR:entry.

	    sock close
	]
									[exEnd]

    example (connect to an ftp server):
									[exBegin]
	|sock host|

	host := OperatingSystem getHostName.
	sock := Socket newTCPclientToHost:host port:'ftp'.

	sock buffered:false.
	Transcript showCR:sock nextLine.
	sock nextPutAll:('USER ' , 'anonymous'); cr.
	Transcript showCR:sock nextLine.
	sock nextPutAll:('PASS ' , 'fooBar'); cr.
	Transcript showCR:sock nextLine.
	sock nextPutAll:'LIST'; cr.
	Transcript showCR:sock nextLine.
	sock close.

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


    example (connect to an snmp server [UDP]):
									[exBegin]
	|sock port|

	sock := Socket newUDP.
	port := Socket portOfService:'snmp'.
	sock connectTo:(OperatingSystem getHostName) port:port.
	sock buffered:false.
	Transcript showCR:'got it'.
	sock close.
									[exEnd]


    example (await connection from a client and read some data):
									[exBegin]
	|connectSock sock|

	connectSock := Socket newTCPserverAtPort:9998.
	connectSock isNil ifTrue:[
	    Transcript showCR:'socket setup failed.'.
	] ifFalse:[
	    Transcript showCR:'listen ..'.
	    (connectSock listenFor:5) ifFalse:[
		Transcript showCR:'listen failed.'.
	    ] ifTrue:[
		Transcript showCR:'wait'.
		connectSock readWait.
		Transcript showCR:'accept'.
		sock := connectSock accept.
		sock isNil ifTrue:[
		    Transcript showCR:'accept failed.'.
		] ifFalse:[
		    sock buffered:false.
		    Transcript showCR:'server: got it'.
		    'can now do transfer via sock'.
		    Transcript showCR:'read'.
		    Transcript showCR:('got: ' , sock nextLine).

		    Transcript showCR:'close'.
		    sock close
		].
		connectSock close.
	    ]
	]
									[exEnd]


    example (connect to above server and send some data):
									[exBegin]
	|sock|

	sock := Socket newTCPclientToHost:(OperatingSystem getHostName) port:9998.
	sock isNil ifTrue:[
	    Transcript showCR:'nope'
	] ifFalse:[
	    sock buffered:false.
	    Transcript showCR:'client: got it'.
	    'can now do transfer via sock'.
	    Transcript showCR:'sending <hello>'.
	    sock nextPutLine:'hello'.
	    sock close
	]
									[exEnd]

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

	|connectSock sock|

	'/tmp/ud_socket' asFilename remove.
	connectSock := Socket newUNIXserverAt:'/tmp/ud_socket'.
	connectSock isNil ifTrue:[
	    Transcript showCR:'socket setup failed.'.
	] ifFalse:[
	    Transcript showCR:'listen ..'.
	    (connectSock listenFor:5) ifFalse:[
		Transcript showCR:'listen failed.'.
	    ] ifTrue:[
		Transcript showCR:'wait'.
		connectSock buffered:false.
		connectSock readWait.
		Transcript showCR:'accept'.
		sock := connectSock accept.
		sock isNil ifTrue:[
		    Transcript showCR:'accept failed.'.
		] ifFalse:[
		    sock buffered:false.
		    Transcript showCR:'server: got it'.
		    'can now do transfer via sock'.
		    Transcript showCR:'read'.
		    Transcript showCR:('got: ' , sock nextLine).

		    Transcript showCR:'close'.
		    sock close
		].
		connectSock close.
	    ]
	]


    example (connect to above server and send some data;
	     Notice, this fails, if above server code is executed in the same ST/X image
		     (at least on LINUX), since the OS does not correctly handle
		     a connect from within an interrupted accept system call
		     On SGI's SVR4, this works ok
									[exBegin]
	|sock|

	sock := Socket newUNIXclientTo:'/tmp/ud_socket'.
	sock isNil ifTrue:[
	    Transcript showCR:'nope'
	] ifFalse:[
	    sock buffered:false.
	    Transcript showCR:'client: got it'.
	    'can now do transfer via sock'.
	    Transcript showCR:'sending <hello>'.
	    sock nextPutLine:'hello'.
	    sock close
	]
									[exEnd]


    example (UDP await packet from a client and read some data):
									[exBegin]
	|udpSock sock addr n dataBuffer|

	udpSock := Socket newUDPserverAtPort:9999.
	udpSock isNil ifTrue:[
	    Transcript showCR:'socket setup failed.'.
	] ifFalse:[
	    Transcript showCR:'wait'.
	    udpSock readWait.

	    addr := IPSocketAddress new.
	    dataBuffer := ByteArray new:1000.
	    n := udpSock receiveFrom:addr buffer:dataBuffer start:1 for:dataBuffer size.
	    n > 0 ifTrue:[
		Transcript showCR:('got: ' , n printString , 'bytes  from ' , addr printString).
		Transcript showCR:('data: ' , (dataBuffer copyTo:n) printString).
	    ] ifFalse:[
		Transcript showCR:'read failed'.
	    ].

	    Transcript showCR:'close'.
	    udpSock close
	]
									[exEnd]
    example (connect to above UDP server and send some data;
									[exBegin]
	|sock|

	sock := Socket newUDP.
	sock isNil ifTrue:[
	    Transcript showCR:'nope'
	] ifFalse:[
	    sock sendTo:(IPSocketAddress new hostName:'localhost' port:9999) buffer:'hello world'.
	    sock close
	]
									[exEnd]

    example: pingWalk (try to ping hosts on the local network)
									[exBegin]
	|myName myAddress list top hosts walkProcess port|

	myName := OperatingSystem getHostName.
	myAddress := Socket ipAddressOfHost:myName.

	port := Socket portOfService:'echo'.
	port isNil ifTrue:[
	    self error:'dont know echo port'.
	    ^ self
	].

	top := StandardSystemView new.
	top label:'PING net walk'.

	list := ScrollableView for:ListView in:top.
	list origin:0.0@0.0 corner:1.0@1.0.

	top openAndWait.

	walkProcess := [
	    |l low hi direction tryHostID dottedName hostName conn addr|

	    l := SortedCollection new.

	    ' only works with type C-net
	      the code below could simply do 1 to:254 do:[:hostID }
	      but, to probe likely hosts earlier, the probing is done
	      ping-pong like around my ip-address (assuming, that other machines
	      have numbers around my own)'.

	    low := hi := (myAddress at:4).
	    direction := 1.

	    [low > 0 or:[hi < 255]] whileTrue:[
		direction > 0 ifTrue:[
		    hi := hi + 1.
		    tryHostID := hi.
		    direction := -1.
		] ifFalse:[
		    low := low - 1.
		    tryHostID := low.
		    direction := 1.
		].
		(tryHostID between:1 and:254) ifTrue:[
		    dottedName := (myAddress at:1) printString
				  , '.' , (myAddress at:2) printString
				  , '.' , (myAddress at:3) printString
				  , '.' , tryHostID printString.

		    top label:'PING net walk - trying ' , dottedName.

		    top windowGroup withCursor:Cursor wait do:[
			conn := Socket newTCPclientToHost:dottedName port:port withTimeout:1000.
			conn notNil ifTrue:[
			    addr := Socket ipAddressOfHost:dottedName.
			    hostName := Socket hostWithIpAddress:addr.
			    hostName isNil ifTrue:[
				hostName :='?'
			    ].
			    l add:(dottedName paddedTo:15 with:Character space)
				   , ' '
				   , (hostName paddedTo:15 with:Character space)
				   , ' up & reachable'.
			    list list:l.
			    conn close.
			]
		    ].
		].
	    ].
	    top label:'PING reachable hosts'.
	] forkAt:(Processor userBackgroundPriority).
	walkProcess name:'ping net walker'.
									[exEnd]


	This example creates a simple UDP server that accepts
	single packets from anybody and broadcasts them to all
	clients that have connected so far.

									[exBegin]
	| socket address buffer msgSize clients |
	clients := Set new.
	address := IPSocketAddress new.
	buffer := String new: 1024.

	socket := self newUDPserverAtPort: 6666.

	Transcript showCR: 'server starting'.

	[
	    [true] whileTrue: [
		(socket readWaitWithTimeoutMs: 200) ifFalse: [
		    msgSize := socket
			    receiveFrom: address
			    buffer: buffer
			    start: 1
			    for: buffer size.

		    clients add: address copy.
		    clients do: [ :clientAddress |
			    socket
				    sendTo: clientAddress
				    buffer: buffer
				    start: 1
				    for: msgSize]]
	    ]
	] valueNowOrOnUnwindDo:[
	    Transcript showCR: 'server shutting down'.
	    socket close
	]
									[exEnd]

   send a datagram to above server:
									[exBegin]

	| socket address buffer host msg |

	host := Dialog
		request: 'What is the name of the server''s host?'
		initialAnswer: 'localhost'.

	socket := self newUDP.

	address := IPSocketAddress hostName: host port: 6666.

	buffer := ByteArray new: 1000.
	[
	    [(msg := Dialog request: 'Say something') isEmpty] whileFalse:[
		| replySize stream |

		socket writeWait.
		stream := buffer writeStream.
		stream nextPutAll: msg.
		socket sendTo:address buffer:buffer start:1 for:stream position.
		socket readWait.

		replySize := socket receiveFrom:address buffer:buffer.
		replySize > 0 ifTrue: [
		    Transcript cr; nextPutAll: 'Server acknowledged: '.
		    Transcript show: ((buffer copyFrom: 1 to: replySize) asString)
		]
	    ]
	] valueNowOrOnUnwindDo: [socket close].
	Transcript cr
									[exEnd]


   loopBack:
									[exBegin]

	|readerTask readingSocket writingSocket|

	readingSocket := self newTCPserverAtPort:9999.
	readerTask :=
	    [
		|connection|

		readingSocket listenFor:1.
		connection := readingSocket accept.
		readingSocket close.
		[connection atEnd] whileFalse:[
		    Transcript showCR:(connection nextLine).
		].
		connection close.
	    ] fork.

	Delay waitForSeconds:1.
	writingSocket := self newTCPclientToHost:(OperatingSystem getHostName) port:9999.
	writingSocket nextPutLine:'Hello'.
	writingSocket nextPutLine:'World'.
	writingSocket close.
									[exEnd]
"
! !

!Socket class methodsFor:'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, #appletalk, #decnet, #xns, ...;
     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:#unix type:#stream
     Socket domain:#appletalk type:#stream
     Socket domain:#decnet type:#stream
     Socket domain:#irda type:#stream
    "
!

new
    "create a TCP socket"

    ^ super new buffered:false
!

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.
        ] ifCurtailed:[
            newSock close.
        ]
    ].
    ^ newSock


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

newTCPclientToAddress:aHostAddress port:aService
    "create a new TCP client socket connecting to a service.
     Return a socket instance if ok, nil on failure.
     Block until a connection is established (but only the current thread;
     not the whole smalltalk).
     See also: #newTCPclientToAddress:port:withTimeout:"

    ^ self newTCPclientToAddress:aHostAddress port:aService withTimeout:nil
!

newTCPclientToAddress:aHostAddress port:aService withTimeout:millis
    "create a new TCP client socket connecting to a service.
     Return a socket instance if ok, nil on failure.
     If the millis arg is nonNil, stop trying to connect after that many milliseconds
     and return nil."

    ^ self newTCPclientToHost:aHostAddress port:aService withTimeout:millis
!

newTCPclientToHost:hostname port:aService
    "create a new TCP client socket connecting to a service.
     Return a socket instance if ok, nil on failure.
     Block until a connection is established (but only the current thread;
     not the whole smalltalk).
     See also: #newTCPclientToHost:port:withTimeout:"

    ^ self newTCPclientToHost:hostname port:aService withTimeout:nil

    "
      Socket newTCPclientToHost:'localhost' port:'nntp'
    "

    "Created: 31.10.1995 / 18:54:11 / cg"
!

newTCPclientToHost:hostname port:aService withTimeout:millis
    "create a new TCP client socket connecting to a service.
     Return a socket instance if ok, nil on failure.
     If the millis arg is nonNil, stop trying to connect after that many milliseconds
     and return nil.."

    |newSock|

    newSock := self newTCP.
    newSock notNil ifTrue:[
	(newSock connectTo:hostname
		 port:(self portOfService:aService protocol:'tcp')
		 withTimeout:millis
	) ifFalse:[
	    newSock close.
	    ^ nil
	]
    ].
    ^ newSock
"
same as:
    ^ (self new) for:hostname port:(self portOfService:aPort).
"
    "
      Socket newTCPclientToHost:'slsv6bt' port:'nntp'
      Socket newTCPclientToHost:'localhost' port:'nntp' withTimeout:1000
    "

    "Modified: / 16.1.1998 / 09:47:06 / stefan"
!

newTCPserverAtAnonymousPort
    "create a new TCP server socket providing service on
     a new anonymous port. The portNr is assigned by the OS."

    ^ self newTCPserverAtPort:0

!

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

    ^ self newTCP:aService
!

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.
        ] ifCurtailed:[
            newSock close.
        ]
    ].
    ^ newSock

    "
        Socket newUDP:nil.
        Socket newUDP:'rwho'.
    "
!

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

    ^ self newUDP:aService
!

newUNIX
    "create a UNIX domain socket - no binding or other setup is done,
     neither connect nor connect-wait is done.
     If the system does not support unix domain sockets (i.e. VMS or MSDOS),
     return nil."

    ^ self new domain:#unix type:#stream

    "
     Socket newUNIX
    "
!

newUNIXclientTo:pathName
    "create a new UNIX client socket connecting to a pathname.
     Return a socket instance if ok, nil on failure.
     Block until a connection is established (but only the current thread;
     not the whole smalltalk).
     If the system does not support unix domain sockets (i.e. VMS or MSDOS),
     return nil.
     See also: #newUNIXclientTo:withTimeout:"

    ^ self newUNIXclientTo:pathName withTimeout:nil

!

newUNIXclientTo:pathName withTimeout:millis
    "create a new UNIX client socket connecting to a pathname.
     Return a socket instance if ok, nil on failure.
     If the millis arg is nonNil, stop trying to connect after that many milliseconds
     and return nil.
     If the system does not support unix domain sockets (i.e. VMS or MSDOS),
     return nil."

    |newSock|

    newSock := self newUNIX.
    newSock notNil ifTrue:[
	(newSock connectTo:'localhost' port:pathName withTimeout:millis) ifFalse:[
	    newSock close.
	    ^ nil
	]
    ].
    ^ newSock

    "
     |s|

     s := Socket newUNIXclientTo:'/tmp/foo'
    "
!

newUNIXserverAt:pathName
    "create a new UNIX server socket providing service at a pathname.
     If the system does not support unix domain sockets (i.e. VMS or MSDOS),
     return nil."

    |newSock|

    newSock := self newUNIX.
    newSock notNil ifTrue:[
        [
            newSock bindTo:pathName address:nil.
        ] ifCurtailed:[
            newSock close.
        ]
    ].
    ^ newSock

    "
     |s s2|

     s := Socket newUNIXserverAt:'/tmp/foo'.
     s listenFor:5.
     s2 := s accept.
    "
! !

!Socket class methodsFor:'Compatibility-ST80'!

family:domainSymbol type:typeSymbol
    "create a socket for domain and type - ST80 simply uses a different name.
     Domain must be one of the symbols: #inet, #unix, #appletalk or #ns;
     Type must be #stream, #datagram or #raw."

    ^ self domain:domainSymbol type:typeSymbol

    "
     Socket family:#inet type:#stream
     Socket family:#inet type:#datagram
     Socket family:#unix type:#stream
    "
!

getHostname
    "return the computers hostname string"

    ^ OperatingSystem getHostName

    "Created: / 27.2.1998 / 02:32:17 / cg"
!

sockStream
    "return the type code for stream sockets"

    ^ #stream
! !

!Socket class methodsFor:'Compatibility-Squeak'!

initializeNetwork
    "/ intentionally left blank here
!

wildcardPort
    ^ nil
! !

!Socket class methodsFor:'Compatibility-VW'!

AF_INET
    ^ #AF_INET
!

SOCK_STREAM
    ^ #SOCK_STREAM
! !

!Socket class methodsFor:'Signal constants'!

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
!

invalidArgumentsSignal
    "dummy for compatibility"

    ^ self errorSignal
! !

!Socket class methodsFor:'debugging'!

debug:aBoolean
    "turn on/off internal debugprints.
     This method is for ST/X debugging only and
     may  be removed in later versions"

%{  /* NOCONTEXT */

    __debugging__ = (aBoolean == true);
%}
    "
     Socket debug:true
     Socket debug:false
    "
! !

!Socket class methodsFor:'obsolete'!

connectTo:service on:host
    <resource: #obsolete>
    "standard & easy client setup:
        create new client tcp socket, bind and connect;
        return the socket.
     The thread blocks (interruptable), until the connection is established."

    ^ self newTCPclientToHost:host port:(self portOfService:service).

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

networkLongOrderIsMSB
    "return the well known fact, that network byte order is most significant byte first"

    <resource: #obsolete>

    ^ true
!

networkShortOrderIsMSB
    "return the well known fact, that network byte order is most significant byte first"

    <resource: #obsolete>

    ^ true
!

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

    <resource:#obsolete>

    |newSock|

    self obsoleteMethodWarning:'use #newTCPserverAtPort: / #listen'.

    newSock := self newTCPserverAtPort:(self portOfService:aService).
    newSock notNil ifTrue:[
	newSock listenFor:5.
    ].
    ^ newSock

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

!Socket class methodsFor:'obsolete host queries'!

appletalkAddressOfHost:aHostName
    <resource: #obsolete>
    "return the APPLETALK address for a hostname as a byteArray,
     where the network bytes come first (no matter what the local byteorder is)
     followed by the node byte.
     If the host is unknown, return nil.
     This is the reverse operation to #hostWithAppletalkAddress:.
     WARNING: untested code - I have no appletalk to test this."

    NameLookupError
	handle:[:ex |
	    ^ nil
	]
	do:[
	    ^ (AppletalkSocketAddress hostName:aHostName) address
	]
!

hostWithAppletalkAddress:addrByteArray
    <resource: #obsolete>
    "return the hostname for an APPLETALK address.
     The address is supposed to be a byteArray consisting of 3 bytes,
     the network bytes come first (no matter what the local byteorder is).
     The last byte is the node number.
     Nil is returned for an unknown host or if its not an appletalk host.
     This is is the reverse operation to #appletalkAddressOfHost:.
     WARNING: untested code - I have no appletalk to test this."

    NameLookupError
	handle:[:ex |
	    ^ nil
	]
	do:[
	    ^ (AppletalkSocketAddress hostAddress:addrByteArray) hostName
	]

    "
     Socket appletalkAddressOfHost:'yourAppleHere'
     Socket hostWithAppletalkAddress:#[1 2 3]
     "
!

hostWithIpAddress:addrByteArray
    <resource: #obsolete>
    "return the hostname for an IP (internet-) address.
     The address is supposed to be a byteArray consisting of 4 bytes,
     the network bytes come first (no matter what the local byteorder is).
     Nil is returned for an unknown host or if its not an internet host.
     This is the reverse operation to #ipAddressOfHost:."

    NameLookupError
	handle:[:ex |
	    ^ nil
	]
	do:[
	    ^ (IPSocketAddress hostAddress:addrByteArray) hostName
	]

    "
     Socket ipAddressOfHost:'clam'
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'clam')
     Socket ipAddressOfHost:'porty'
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'porty')
     Socket hostWithIpAddress:#[1 2 3 4]
     Socket hostWithIpAddress:#[127 0 0 1]
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'1.2.3.4')
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'www.altavista.com')
     "
!

hostWithIpV6Address:addrByteArray
    <resource: #obsolete>
    "return the hostname for an IPv6 (internet-) address.
     The address is supposed to be a byteArray consisting ??? bytes,
     the network bytes come first (no matter what the local byteorder is).
     Nil is returned for an unknown host or if its not an internet host.
     This is the reverse operation to #ipV6AddressOfHost:."

    NameLookupError
	handle:[:ex |
	    ^ nil
	]
	do:[
	    ^ (IPv6SocketAddress hostAddress:addrByteArray) hostName
	]

    "
     Socket ipV6AddressOfHost:'clam'
     Socket hostWithIpV6Address:(Socket ipAddressOfHost:'clam')
     Socket ipV6AddressOfHost:'porty'
     Socket hostWithIpV6Address:(Socket ipAddressOfHost:'porty')
     Socket hostWithIpV6Address:#[1 2 3 4 5 6 7 8 9 10 11 12 13 14]
     Socket ipV6AddressOfHost:'www.exept.de'
     "
!

ipAddressOfHost:aHostName
    <resource: #obsolete>
    "return the IP (internet-) number for a hostname as a byteArray,
     where the network bytes come first (no matter what the cpus byteOrder is).
     If the host is unknown, return nil.
     This is the reverse operation to #hostWithIpAddress:."

    NameLookupError
	handle:[:ex |
	    ^ nil
	]
	do:[
	    ^ (IPSocketAddress hostName:aHostName) address
	]

    "
     Socket ipAddressOfHost:'localhost'
     Socket ipAddressOfHost:'exept'
     Socket ipAddressOfHost:'1.2.3.4'
     Socket ipAddressOfHost:'193.15.16.17'
     Socket ipAddressOfHost:'josef'
     Socket ipAddressOfHost:'styx.com'
     Socket hostWithIpAddress:(Socket ipAddressOfHost:'localhost')
     Socket ipAddressOfHost:(Socket hostWithIpAddress:'127.0.0.1')
    "
!

ipV6AddressOfHost:aHostName
    <resource: #obsolete>
    "return the IPv6 (internet-) number for a hostname as a byteArray,
     where the network bytes come first (no matter what the cpus byteOrder is).
     If the host is unknown, return nil.
     This is the reverse operation to #hostWithIpV6Address:."

    NameLookupError
	handle:[:ex |
	    ^ nil
	]
	do:[
	    ^ (IPv6SocketAddress hostName:aHostName) address
	]

    "
     Socket ipV6AddressOfHost:'localhost'
     Socket ipV6AddressOfHost:'exept'
     Socket ipV6AddressOfHost:'exept.exept.de'
     Socket ipV6AddressOfHost:'www.google.de'
     Socket ipV6AddressOfHost:'1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.16'
     Socket ipV6AddressOfHost:'josef'
     Socket ipV6AddressOfHost:'styx.com'
     Socket hostWithIpV6Address:(Socket ipV6AddressOfHost:'localhost')
     Socket ipV6AddressOfHost:(Socket hostV6WithIpAddress:'127.0.0.1')
    "
! !

!Socket class methodsFor:'queries'!

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].
    "
     unix domain
    "
    (aProtocol = 'ud')  ifTrue:[^ #unix].

    "
     add x25 stuff (if any) here ...
    "
    "
     add appletalk stuff (if any) here ...
    "
    "
     add other stuff (if any) here ...
    "
    ^ nil

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

peerFromDomain:domain name:peerName port:port
    |addrClass|

    addrClass := self socketAddressClassForDomain:domain.
    ^ addrClass hostName:peerName serviceName:port type:nil
!

peerNameFromDomain:domain peer:peer
    |addrClass|

    addrClass := self socketAddressClassForDomain:domain.
    ^ addrClass peerNameFromPeer:peer
!

portOfService:aNameOrNumber
    "returns the port-number for a given IP-service
     or nil if no such service exists;
     - used to convert service names to portNumbers"

    ^ self portOfService:aNameOrNumber protocol:nil

    "
     Socket portOfService:'finger'
     Socket portOfService:'nntp'
     Socket portOfService:'echo'
     Socket portOfService:'snmp'
    "
!

portOfService:aNameOrNumber protocol:aProtocol
    "returns the port-number for a given IP-service
     or nil if no such service exists;
     - used to convert service names to portNumbers"

%{ /* UNLIMITEDSTACK */
#ifndef NO_SOCKET
    struct servent *servent = NULL;
    char *protocol;
    int tryBoth = 0;
    short portNo;

    if (__isSmallInteger(aNameOrNumber)) {
	RETURN ( aNameOrNumber );
    }

    if (__isString(aProtocol)) {
	protocol = (char *)__stringVal(aProtocol);
    } else {
	protocol = "tcp";
	tryBoth = 1;
    }

    if (__isString(aNameOrNumber) || __isSymbol(aNameOrNumber)) {
	servent = getservbyname((char *) __stringVal(aNameOrNumber), protocol);
	if (servent != NULL) {
	    RETURN ( __MKSMALLINT(ntohs(servent->s_port)) );
	}
	if (tryBoth) {
	    servent = getservbyname((char *) __stringVal(aNameOrNumber), "udp");
	    if (servent != NULL) {
		RETURN ( __MKSMALLINT(ntohs(servent->s_port)) );
	    }
	}
	RETURN ( nil );
    }
#endif
    RETURN ( nil );
%}
    "
     Socket portOfService:'echo' protocol:'udp'
     Socket portOfService:'echo' protocol:'tcp'
    "
!

protocolOfService:aNameOrNumber
    "returns the protocol (as string) for a given IP-service
     or nil if no such service exists."

%{  /* UNLIMITEDSTACK(noWIN32) */
#ifndef NO_SOCKET
    struct servent *servent = NULL;
    short portNo;

    if (__isSmallInteger(aNameOrNumber)) {
	portNo = __intVal(aNameOrNumber);
	servent = getservbyport(htons(portNo), "tcp") ;
	if (servent == NULL) {
	    servent = getservbyport(htons(portNo), "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) );
    }
#endif /* !NO_SOCKET */
    RETURN ( nil );
%}
    "
     Socket protocolOfService:'finger'
     Socket protocolOfService:'nntp'
     Socket protocolOfService:'xxx'
     Socket protocolOfService:79
     Socket protocolOfService:'snmp'
    "
!

socketAddressClassForDomain:domain
    ^ SocketAddress knownClassFromCode:domain

    "
     self socketAddressClassForDomain:#inet
     self socketAddressClassForDomain:#unix
    "
!

supportedProtocolFamilies
    "return a collection of supported protocol families.
     This list specifies what the Socket class supports -
     socket creation may still fail, if your system was built
     without it."

    ^ OperatingSystem supportedProtocolFamilies

    "
     Socket supportedProtocolFamilies
    "
!

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].
    "
     unix domain
    "
    (aProtocol = 'ud')  ifTrue:[^ #stream].
    "
     add x25 stuff (if any) here ...
    "
    "
     add appletalk stuff (if any) here ...
    "
    "
     add other stuff (if any) here ...
    "
    ^ nil

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

!Socket methodsFor:'Compatibility-Dolphin'!

setReceiveTimeout: milliseconds
    self receiveTimeout:(milliseconds / 1000)
!

setSendTimeout: milliseconds
    self sendTimeout:(milliseconds / 1000)
! !

!Socket methodsFor:'Compatibility-ST80'!

acceptNonBlock
    ^ self accept
!

connectTo:aSocketAddress
    ^ self connectTo:aSocketAddress hostAddress port:aSocketAddress port
!

errorReporter
    "ST-80 mimicry."

    ^ self class
!

ioConnection
    ^ self
!

notReadySignal
    "ST-80 mimicry.
     for now - this is not yet raised"

    ^ Signal new
!

readAppendStream
    "ST-80 mimicry.
     In ST-80, socket is not a stream, but referes to one.
     ST-80 code therefore uses 'Socket readWriteStream' to access
     the actual stream.
     In ST/X, sockets inherit from stream, so
     this method returns the receiver, for transparency"

    ^ self
!

readStream
    "ST-80 mimicry.
     In ST-80, socket is not a stream, but referes to one.
     ST-80 code therefore uses 'Socket readStream' to access
     the actual stream.
     In ST/X, sockets inherit from stream, so
     this method returns the receiver, for transparency"

    ^ self

    "Created: 24.1.1997 / 23:52:57 / cg"
!

writeStream
    "ST-80 mimicry.
     In ST-80, socket is not a stream, but referes to one.
     ST-80 code therefore uses 'Socket writeStream' to access
     the actual stream.
     In ST/X, sockets inherit from stream, so
     this method returns the receiver, for transparency"

    ^ self

    "Created: 24.1.1997 / 10:34:35 / cg"
    "Modified: 24.1.1997 / 23:52:52 / cg"
! !

!Socket methodsFor:'Compatibility-Squeak'!

address
    ^ self getSocketAddress
!

dataAvailable
    ^ self canReadWithoutBlocking
!

destroy
    self close

    "Created: / 04-06-2007 / 21:29:03 / cg"
!

listenOn:aPortNr
    self listenOn:aPortNr backlogSize:5

    "Modified: / 31-05-2007 / 17:59:53 / cg"
!

listenOn:aPortNr backlogSize:aNumber
    self bindTo:aPortNr address:nil.
    self listenFor:aNumber

    "Created: / 31-05-2007 / 17:59:47 / cg"
!

peerName
    "return my peer (i.e. ipAddr + port);
     May return nil if not yet setup completely."

    ^ self getPeer
!

primSocketLocalPort:aSocket
    ^ self port
!

sendData: aStringOrByteArray
	"Send all of the data in the given array, even if it requires multiple calls to send it all.
	 Return the number of bytes sent."

	"An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts."

	|remaining nWritten|

Transcript show:'>> '; showCR:aStringOrByteArray.

	remaining := aStringOrByteArray size.
	[remaining > 0] whileTrue:[
	    nWritten := self nextPutBytes:remaining from:aStringOrByteArray startingAt:1.
	    remaining := remaining - nWritten.
	].
	^ aStringOrByteArray size.

"/        | bytesSent bytesToSend count |
"/        bytesToSend := aStringOrByteArray size.
"/        bytesSent := 0.
"/        [bytesSent < bytesToSend] whileTrue: [
"/                (self waitForSendDoneFor: 60)
"/                        ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
"/                count := self primSocket: socketHandle
"/                        sendData: aStringOrByteArray
"/                        startIndex: bytesSent + 1
"/                        count: (bytesToSend - bytesSent min: 5000).
"/                bytesSent := bytesSent + count].
"/
"/        ^ bytesSent
!

setOption: optionName value: optionValue
    optionName = 'TCP_NODELAY' ifTrue:[
        ^ self setTCPNoDelay:optionValue
    ].
    ^ self setSocketOption:optionName argument:optionValue argument:nil

    "Modified: / 04-06-2007 / 21:23:19 / cg"
!

socketHandle
    ^ self
!

waitForConnectionUntil:aMillisecondClockValue
    self shouldImplement.
!

waitForData
    self readWait

    "Created: / 04-06-2007 / 21:28:40 / cg"
! !

!Socket methodsFor:'accepting connections'!

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 primAcceptOn:self blocking:false) ifFalse:[
        "should raise an error here"
        ^ nil
    ].
    ^ newSock

    "
     |sock newSock|

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

blockingAccept
    "create a new TCP socket from accepting on the receiver.
     This method will suspend the smalltalk image with all smalltalk processes if no connection is waiting.
     For ST-80 compatibility"

    |newSock|

    newSock := self class new.
    (newSock primAcceptOn:self blocking:true) ifFalse:[
        "should raise an error here"
        ^ nil
    ].
    ^ newSock
! !

!Socket methodsFor:'binding'!

bindAnonymously
    "bind to any address. A free port will be allocated.
     Our own socket address will be determined after conection set up.
     This is the default after the socket has been created"

    ^ self
	bindTo:nil
	address:nil
	reuseAddress:false
!

bindAnonymouslyToAddress:addressString
    "bind to address addressString.
     A free port will be allocated"

    ^ self
	bindTo:nil
	address:addressString
	reuseAddress:false
!

bindTo:aSocketAddress
    "ST80 compatible bind, expecting a socketAddress argument.
     The socketAddress object (an instance of SocketAddress)
     is supposed to respond to #portOrName and #address requests."

    ^ self bindTo:(aSocketAddress portOrName)
	   address:(aSocketAddress address)
	   reuseAddress:true
!

bindTo:portNrOrNameString address:addressString
    "low level bind - returns true if ok, false otherwise.
     Currently only non-address binding is supported;
     i.e. the address must always be nil.

     The interpretation of portNrOrName depends on the domain:
	inet domain uses (4byte) byteArray like internet numbers,
	unix domain uses pathname strings,
	others use whatever will come up in the future
     "

    ^ self
	bindTo:portNrOrNameString
	address:addressString
	reuseAddress:true
!

bindTo:portNrOrNameOrNil address:hostOrPathNameOrSocketAddrOrNil reuseAddress:reuse
    "low level bind - returns true if ok, false otherwise.
     Currently only non-address binding is supported;
     i.e. address must always be nil.

     The interpretation of portNrOrName depends on the domain:
        inet domain uses (4byte) byteArray like internet numbers,
        unix domain uses pathname strings,
        others use whatever will come up in the future

     The reuse boolean argument controls if the SO_REUSEADDR socket option
     is to be set (to avoid the 'bind: address in use' error).
    "

    |ok addr addrName domainClass error|

    filePointer isNil ifTrue:[
        ^ self errorNotOpen
    ].

    domainClass := self class socketAddressClassForDomain:domain.
    domainClass isNil ifTrue:[
        ^ self error:'invalid (unsupported) domain'.
    ].

    hostOrPathNameOrSocketAddrOrNil isNil ifTrue:[
        addr := domainClass anyHost.
    ] ifFalse:[
        (hostOrPathNameOrSocketAddrOrNil isKindOf:SocketAddress) ifTrue:[
            addr := hostOrPathNameOrSocketAddrOrNil.
        ] ifFalse:[
            "backward compatibility: support for byteArray and string arg"
            hostOrPathNameOrSocketAddrOrNil isString ifTrue:[
                addr := domainClass hostName:hostOrPathNameOrSocketAddrOrNil.
                addrName := hostOrPathNameOrSocketAddrOrNil.
            ] ifFalse:[
                hostOrPathNameOrSocketAddrOrNil isByteArray ifFalse:[
                    ^ self error:'bad host (socketAddress) argument'
                ].
                addr := domainClass hostAddress:hostOrPathNameOrSocketAddrOrNil.
            ].
        ].
    ].
    portNrOrNameOrNil notNil ifTrue:[
        addr port:portNrOrNameOrNil.
    ].
    (portNrOrNameOrNil isNil or:[portNrOrNameOrNil == 0]) ifTrue:[
        addr := addr copy.
    ].

%{  /* STACK: 100000 */
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);

    if (! __isBytes(addr)) {
        error=__mkSmallInteger(-1);
        addr = nil;
        goto getOutOfHere;
    }
    if (fp != nil) {
        SOCKET sock;
        union sockaddr_u sa;
        int sockaddr_size;
        int ret;
        int sockAddrOffs;

        {
            int nIndex;
            OBJ cls;

            sockAddrOffs = 0;
            if ((cls = __qClass(addr)) != @global(ByteArray))
                sockAddrOffs += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
            nIndex = __qSize(addr) - OHDR_SIZE;
            sockaddr_size = nIndex - sockAddrOffs;
            if (sockaddr_size > sizeof(sa)) {
                error=__mkSmallInteger(-2);
                goto getOutOfHere;
            }
            memcpy(&sa, __byteArrayVal(addr) + sockAddrOffs, sockaddr_size);
        }

        sock = SOCKET_FROM_FILE_OBJECT(fp);

# ifdef SO_REUSEADDR
        if (reuse == true) {
            int on = 1;

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

# ifdef BIND_BLOCKS
#  ifdef DO_WRAP_CALLS
        do {
            __threadErrno = 0;
            ret = STX_WSA_CALL3("bind", bind, sock, &sa, sockaddr_size);
        } while ((ret < 0) && (__threadErrno == EINTR));
#  else
        __BEGIN_INTERRUPTABLE__
        do {
            ret = bind(sock, (struct sockaddr *)&sa, sockaddr_size);
        } while ((ret < 0) && (errno == EINTR));
        __END_INTERRUPTABLE__
#  endif
# else
        ret = bind(sock, (struct sockaddr *)&sa, sockaddr_size);
# endif
        if (ret < 0) {
            DBGPRINTF(("SOCKET: bind failed errno=%d\n", errno));
            error = __INST(lastErrorNumber) = __MKSMALLINT(errno);
            goto getOutOfHere;
        } else {
            ok = true;

            if (! __isSmallInteger(portNrOrNameOrNil)
                || (portNrOrNameOrNil == __MKSMALLINT(0))) {
                unsigned int alen = sockaddr_size;

                /*
                 * anonymous port - get the actual portNr
                 */
                if (getsockname(sock, (struct sockaddr *)&sa, &alen) < 0) {
# ifdef WIN32
                    errno = WSAGetLastError();
# endif
                    console_fprintf(stderr, "SOCKET: cannot get socketname: %d\n", errno);
                }
                memcpy(__byteArrayVal(addr) + sockAddrOffs, &sa, alen);
            }
        }
    }
#endif /* NO_SOCKET */

getOutOfHere: ;
%}.
    ok ~~ true ifTrue:[
        "maybe someone catches the error and binds to some other port..."
        OpenError raiseRequestWith:self errorString:('cannot bind socket to port: <1p> address: <2p> (error=<3p>)' 
                                                        expandMacrosWith:portNrOrNameOrNil 
                                                        with:hostOrPathNameOrSocketAddrOrNil
                                                        with:error).
        ^ true.
    ].

    port := addr port.

    ^ true

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

listenFor:aNumber
    "start listening; return true if ok, false on error
     aNumber is the number of connect requests, that may be queued on the socket"

    filePointer isNil ifTrue:[
        ^ self errorNotOpen
    ].
%{
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);
    SOCKET sock;
    int ret;

    if (! __isSmallInteger(aNumber)) {
        DBGPRINTF(("SOCKET: invalid arg\n"));
        RETURN (false);
    }

    sock = SOCKET_FROM_FILE_OBJECT(fp);

#ifdef LISTEN_BLOCKS
# ifdef DO_WRAP_CALLS
    do {
        __threadErrno = 0;
        ret = STX_WSA_CALL2("listen", listen, sock, __intVal(aNumber));
    } while ((ret < 0) && (__threadErrno == EINTR));
# else
    __BEGIN_INTERRUPTABLE__
    do {
        ret = listen(sock, __intVal(aNumber));
    } while ((ret < 0) && (errno == EINTR));
    __END_INTERRUPTABLE__
# endif
#else
    ret = listen(sock, __intVal(aNumber));
#endif

    if (ret < 0) {
        DBGPRINTF(("SOCKET: listen call failed errno=%d\n", errno));
        __INST(lastErrorNumber) = __MKSMALLINT(errno);
        RETURN (false);
    }
#else
    RETURN (false);
#endif
%}.
    listening := true.
    ^ true
! !

!Socket methodsFor:'closing'!

shutDown
    "shutDown and close the socket"

    self shutdown:2.
    self close
!

shutDownInput
    "shutDown the input side of the socket.
     Any read on the socket will signal end-of-file from now on.
     The other side MAY be informed, that no more data will be accepted
     (e.g. setting the TCP-Windowsize to 0)"

    self shutdown:0.
!

shutDownOutput
    "shutDown the output side of the socket.
     Any write to the socket will signal end-of-file from now on.
     The other side will get a end-of-file condition,
     after the last buffered data has been read"

    self shutdown:1.
! !

!Socket methodsFor:'connecting'!

connectTo:hostOrPathName port:portNrOrName
    "low level connect; connect to port, portNrOrNameOrNil on host, hostName.
     For backward compatibility, host may be also a string or a byteArray,
     but it is recommended to pass socketAddress instances.

     Return true if ok, false otherwise.
     The current process will block (but not the whole Smalltalk) until the connection is established.
     See also: #connectTo:port:withTimeout: for a somewhat nicer interface."

    ^ self connectTo:hostOrPathName port:portNrOrName withTimeout:nil
!

connectTo:hostOrPathNameOrSocketAddr port:portNrOrNameOrNil withTimeout:timeout
    "low level connect; connect to port, portNrOrNameOrNil on host, hostName.
     For backward compatibility, host may be also a string or a byteArray,
     but it is recommended to pass socketAddress instances.

     Return true if ok, false otherwise.
     The current process will block (but not the whole Smalltalk) until the connection is established,
     or timeout millliseconds have passed."

    |isAsync err domainClass addr addrName|

    filePointer isNil ifTrue:[
        ^ self errorNotOpen
    ].

    (hostOrPathNameOrSocketAddr isKindOf:SocketAddress) ifTrue:[
        addr := hostOrPathNameOrSocketAddr.
        portNrOrNameOrNil notNil ifTrue:[
            addr port:portNrOrNameOrNil.
        ].
    ] ifFalse:[
        "backward compatibility: support for byteArray and string arg"
        domainClass := self class socketAddressClassForDomain:domain.
        domainClass isNil ifTrue:[
            ^ self error:'invalid (unsupported) domain'.
        ].

        hostOrPathNameOrSocketAddr isString ifTrue:[
            addr := domainClass hostName:hostOrPathNameOrSocketAddr port:portNrOrNameOrNil.
            addrName := hostOrPathNameOrSocketAddr.
        ] ifFalse:[
            hostOrPathNameOrSocketAddr isByteCollection ifFalse:[
                ^ self error:'bad host (socketAddress) argument'
            ].
            addr := domainClass hostAddress:hostOrPathNameOrSocketAddr port:portNrOrNameOrNil.
        ].
    ].

%{  /* STACK: 100000 */

#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);
    union sockaddr_u sa;
    SOCKET sock;
    int a;
    int ret, oldFlags;
    int on = 1;
    int sockaddr_size;

    if (!__isNonNilObject(addr) || !__isBytes(addr)) {
        DBGPRINTF(("SOCKET: invalid addrBytes\n"));
        RETURN (false);
    }

    {
        int sockAddrOffs, nIndex;
        OBJ cls;

        sockAddrOffs = 0;
        if ((cls = __qClass(addr)) != @global(ByteArray))
            sockAddrOffs += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
        nIndex = __qSize(addr) - OHDR_SIZE;
        sockaddr_size = nIndex - sockAddrOffs;
        if (sockaddr_size > sizeof(sa)) {
            console_fprintf(stderr, "Socket: bad socketAddr\n");
            RETURN (false);
        }
        bcopy((__byteArrayVal(addr) + sockAddrOffs), &sa, sockaddr_size);
    }

    sock = SOCKET_FROM_FILE_OBJECT(fp);

# if defined(O_NONBLOCK)
#  if !defined(WIN32)
    /*
     * set to non-blocking and wait later
     */
    oldFlags = fcntl(sock, F_GETFL, 0);
    /* on SUNOS4.x, would use fcntl(osfd, F_SETFL, flags | FNDELAY); */
    fcntl(sock, F_SETFL, oldFlags | O_NONBLOCK);
#  endif
# endif

    /*
     * connect
     */
# ifdef DO_WRAP_CALLS
    do {
        DBGFPRINTF((stderr, "SOCKET: connect...\n"));
        __threadErrno = 0;
        ret = STX_WSA_NOINT_CALL3("connect", connect, sock, &sa, sockaddr_size);
        DBGFPRINTF((stderr, "SOCKET: connect(%d) -> %d (%d)\n", sock, ret, __threadErrno));
    } while ((ret < 0) && (__threadErrno == EINTR));
# else
    __BEGIN_INTERRUPTABLE__
    do {
        ret = connect(sock, (struct sockaddr *)&sa, sockaddr_size);
    } while ((ret < 0)
             && ((errno == EINTR)
# ifdef EAGAIN
                 || (errno == EAGAIN)
# endif
                ));
    __END_INTERRUPTABLE__
#endif

    if (ret < 0) {
# if defined(EINPROGRESS) || defined(EALREADY)
        if (0
#  ifdef EINPROGRESS
            || (errno == EINPROGRESS)
#  endif
#  ifdef EALREADY
            || (errno == EALREADY)
#  endif
        ) {
            /*
             * This was a nonblocking operation that will take some time.
             * Do a select on read to get informed when the operation is ready.
             */
            DBGFPRINTF((stderr, "SOCKET: isAsync is true\n"));
            isAsync = true;
        } else
# endif /* EINPROGRESS or EALREADY */
        {
            DBGFPRINTF((stderr, "SOCKET: connect failed ret=%d errno=%d __threadErrno=%d\n",
                        ret, errno, __threadErrno ));
# ifdef DUMP_ADDRESS
            {
                char *cp = (char *)(&sa);
                int i;

                console_printf("address data:\n");
                for (i=0; i<sockaddr_size; i++) {
                    console_printf(" %02x\n", *cp++);
                }
            }
# endif
            __INST(lastErrorNumber) = __MKSMALLINT(errno);
            RETURN (false);
        }
    }

# if defined(O_NONBLOCK)
#  if !defined(WIN32)
    fcntl(sock, F_SETFL, oldFlags);
#  endif
# endif

# else /* NO_SOCKET */
    RETURN (false);
# endif /* NO_SOCKET */
%}.
    isAsync == true ifTrue:[
        (self writeWaitWithTimeoutMs:timeout) ifTrue:[
            "/ a timeout occured
            "/ should cancel the connect?
            ^ false.
        ].
        err := self getSocketError.
        err ~~ 0 ifTrue:[
            lastErrorNumber := err.
            ^ false.
        ].
    ].

    peer := addr.
    peerName := addrName.
    port isNil ifTrue:[
        "socket has not been explicitly bound,
         after connect it has been bound implicitly - fetch the port"
        port := self getFullSocketAddress port.
    ].
    ^ true

    "
       |sock|
       sock := Socket newTCP.
       sock connectTo:'localhost' port:21 withTimeout:1000.
       sock

       |sock|
       sock := Socket newTCP.
       sock connectTo:'localhost' port:9876 withTimeout:2000.
       sock
    "
! !

!Socket methodsFor:'datagram transmission'!

receiveBuffer:aDataBuffer start:startIndex for:nBytes
    "receive data
     Return the number of bytes received, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable.
     The thread blocks until data arrives - you may want to wait before
     receiving, using #readWait or #readWaitWithTimeout:."

    |nReceived|

%{
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);

    if (fp != nil) {
	SOCKET sock;
	int objSize, offs;
	int n;
	char *extPtr;
	unsigned char *buffer;
	unsigned char *allocatedBuffer;
	int flags = 0;

	sock = SOCKET_FROM_FILE_OBJECT(fp);

	if (! setupBufferParameters(aDataBuffer, startIndex, &extPtr, &offs, &objSize)) goto bad;
	if (__isSmallInteger(nBytes)) {
	    if (__intVal(nBytes) < objSize) {
		objSize = __intVal(nBytes);
	    }
	}

# ifdef DO_WRAP_CALLS
	if (extPtr) {
	    buffer = extPtr + offs;
	} else {
	    allocatedBuffer = buffer = (char *)malloc(objSize);
	}

	do {
	    __threadErrno = 0;
	    n = STX_WSA_CALL4("recv", recv, sock, buffer, objSize, flags);
	} while ((n < 0) && (__threadErrno == EINTR));

	if (allocatedBuffer) {
	    if (n > 0) {
		bcopy(allocatedBuffer, (char *)__InstPtr(aDataBuffer) + offs, n);
	    }
	    free(allocatedBuffer);
	}
# else
	__BEGIN_INTERRUPTABLE__
	do {
	    if (extPtr) {
		n = recv(sock, extPtr + offs, objSize, flags);
	    } else {
		n = recv(sock, (char *)__InstPtr(aDataBuffer) + offs, objSize, flags);
	    }
	} while ((n < 0) && (errno == EINTR));
	__END_INTERRUPTABLE__
# endif

	if (n < 0) {
	    __INST(lastErrorNumber) = __MKSMALLINT(errno);
	}
	nReceived = __MKSMALLINT(n);
    }
#endif
bad: ;
%}.
    nReceived notNil ifTrue:[
	nReceived < 0 ifTrue:[
	    'Socket [warning]: ' infoPrint.
	    (OperatingSystem errorTextForNumber:lastErrorNumber) infoPrintCR.
	].
	^ nReceived
    ].
    "
     arrive here if you try to receive into an invalid buffer (i.e. not ByteArray-like)
    "
    self primitiveFailed
!

receiveFrom:anAddressBuffer buffer:aDataBuffer
    "receive datagramm data - put address of originating host into
     anAddressBuffer, data into aBuffer.
     Both must be ByteArray-like. The addressBuffer must
     provide space for a valid address for my domain (i.e. for inet, a 4-byte byteArray).
     Return the number of bytes received, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable."

    ^ self receiveFrom:anAddressBuffer buffer:aDataBuffer start:1 for:(aDataBuffer size)
!

receiveFrom:anAddressBuffer buffer:aDataBuffer start:startIndex for:nBytes
    "receive datagramm data
     - put address of originating host into anAddressBuffer, data into aBuffer.
     For backward compatibility, the addressBuffer may be a non-SocketAddress;
     then, it must be a byteArray with appropriate size for the addressBytes.

     Return the number of bytes received, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable.
     The thread blocks until data arrives - you may want to wait before
     receiving, using #readWait or #readWaitWithTimeout:."

    |domainClass addr addrLen nReceived|

    domainClass := self class socketAddressClassForDomain:domain.
    domainClass isNil ifTrue:[
	^ self error:'invalid (unsupported) domain'.
    ].
    (anAddressBuffer isKindOf:SocketAddress) ifTrue:[
	anAddressBuffer class == domainClass ifFalse:[
	    ^ self error:'addressBuffer class mismatch (domain)'.
	].
	addr := anAddressBuffer.
    ] ifFalse:[
	anAddressBuffer notNil ifTrue:[
	    addr := domainClass new.
	].
    ].

%{
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);

    if (fp != nil) {
	SOCKET sock;
	int objSize;
	union sockaddr_u sa;
	unsigned int alen = 0;
	int n, offs;
	int flags = 0;
	char *extPtr;
	unsigned char *allocatedBuffer = NULL;
	unsigned char *buffer = NULL;

	sock = SOCKET_FROM_FILE_OBJECT(fp);

	if (! setupBufferParameters(aDataBuffer, startIndex, &extPtr, &offs, &objSize)) goto bad;
	if (__isSmallInteger(nBytes)) {
	    if (__intVal(nBytes) < objSize) {
		objSize = __intVal(nBytes);
	    }
	}
# ifdef DO_WRAP_CALLS
	if (extPtr) {
	    buffer = extPtr + offs;
	} else {
	    allocatedBuffer = buffer = (char *)malloc(objSize);
	}

	do {
	    __threadErrno = 0;
	    alen = sizeof(sa);
	    n = STX_WSA_CALL6("recvfrom", recvfrom, sock, buffer, objSize, flags, (struct sockaddr *)&sa, &alen);
	} while ((n < 0) && (__threadErrno == EINTR));

	if (allocatedBuffer) {
	    if (n > 0) {
		bcopy(allocatedBuffer, (char *)__InstPtr(aDataBuffer) + offs, n);
	    }
	    free(allocatedBuffer);
	}
# else
	__BEGIN_INTERRUPTABLE__
	do {
	    alen = sizeof(sa);
	    if (extPtr) {
		n = recvfrom(sock, extPtr + offs, objSize, flags, (struct sockaddr *) &sa, &alen);
	    } else {
		n = recvfrom(sock, (char *)__InstPtr(aDataBuffer) + offs, objSize, flags, (struct sockaddr *) &sa, &alen);
	    }
	} while ((n < 0) && (errno == EINTR));
	__END_INTERRUPTABLE__
# endif

	if (n >= 0) {
	    if (__isNonNilObject(addr)) {
		char *addrPtr;
		OBJ oClass;
		int nInstVars, nInstBytes, objSize;

		oClass = __qClass(addr);
		if (! __isBytes(addr) )
		    goto bad;
		nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
		nInstBytes = OHDR_SIZE + (nInstVars * sizeof(OBJ));
		objSize = __qSize(addr) - nInstBytes;
		addrPtr = (char *)__InstPtr(addr) + nInstBytes;
		if (objSize < alen)
		    goto bad;

		/*
		 * extract the datagrams address
		 */
		bcopy((char *)&sa, addrPtr, alen);
		addrLen = __MKSMALLINT(alen);
	    }
	}
	if (n < 0) {
	    __INST(lastErrorNumber) = __MKSMALLINT(errno);
	}
	nReceived = __MKSMALLINT(n);
    }
#endif
bad: ;
%}.
    nReceived notNil ifTrue:[
	nReceived < 0 ifTrue:[
	    'Socket [warning]: ' infoPrint.
	    (OperatingSystem errorTextForNumber:lastErrorNumber) infoPrintCR.
	].
	addrLen notNil ifTrue:[
	    (addr == anAddressBuffer) ifFalse:[
		self obsoleteFeatureWarning:'please use a socketAddress argument'.

		" can be a ByteArray for backward compatibility "
		anAddressBuffer replaceFrom:1 to:addrLen with:(addr hostAddress).
	    ].
	].
	^ nReceived
    ].
    "
     arrive here if you try to receive into an invalid buffer
     (i.e. not ByteArray-like),
     or if the addressBuffer is nonNil AND not a SocketAddress/ByteArray
     or if the addressBuffer is nonNil AND too small.
    "
    self primitiveFailed
!

sendBuffer:aDataBuffer start:startIndex for:nBytes flags:flags
    "send data.
     Both must be ByteArray-like. The bytes in the addressBuffer must
     be a valid address for my domain (i.e. for inet, a 4-byte byteArray).
     Return the number of bytes transmitted, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable."

    |nReceived portNo|

%{
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);

    if ((fp != nil)
     && __isSmallInteger(startIndex)
     && __isSmallInteger(nBytes)) {
	SOCKET sock;
	int objSize;
	int n;
	char *extPtr;
	int _flags = 0;
	int offs;
	unsigned long norder;
	unsigned char *buffer;
	unsigned char *allocatedBuffer;

	_flags = __longIntVal(flags);

	sock = SOCKET_FROM_FILE_OBJECT(fp);

	if (! setupBufferParameters(aDataBuffer, startIndex, &extPtr, &offs, &objSize)) goto bad;
	if (__isSmallInteger(nBytes)) {
	    if (__intVal(nBytes) < objSize) {
		objSize = __intVal(nBytes);
	    }
	}

# ifdef DGRAM_DEBUG
	console_printf("sending %d bytes ...\n", nBytes);
# endif

#ifdef DO_WRAP_CALLS
	if (extPtr) {
	    buffer = extPtr + offs;
	} else {
	    allocatedBuffer = buffer = (char *)malloc(objSize);
	    bcopy((char *)__InstPtr(aDataBuffer) + offs, allocatedBuffer, objSize);
	}

	do {
	    __threadErrno = 0;
	    n = STX_WSA_CALL4("send", send, sock, buffer, objSize, _flags);
	} while ((n < 0) && (__threadErrno == EINTR));

	if (allocatedBuffer) {
	    free(allocatedBuffer);
	}
#else
	__BEGIN_INTERRUPTABLE__
	do {
	    if (extPtr) {
		n = send(sock, extPtr + offs, objSize, _flags);
	    } else {
		n = send(sock, (char *)__InstPtr(aDataBuffer) + offs, objSize, _flags);
	    }
	} while ((n < 0) && (errno == EINTR));
	__END_INTERRUPTABLE__
#endif

	if (n < 0) {
	    __INST(lastErrorNumber) = __MKSMALLINT(errno);
	}
	RETURN (__MKSMALLINT(n));
    }
#endif
bad: ;
%}.
    "
     arrive here if you try to send from an invalid buffer (i.e. not ByteArray-like),
    "
    self primitiveFailed
!

sendTo:anAddressBuffer buffer:buffer
    "send datagramm data - fetch address of destination host from
     anAddressBuffer, data from aDataBuffer.
     Both must be ByteArray-like. The bytes in the addressBuffer must
     be a valid address for my domain (i.e. for inet, a 4-byte byteArray).
     Return the number of bytes transmitted, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable.
     Flags is currently ignored; it is there for ST-80 compatibility."

    ^ self sendTo:anAddressBuffer buffer:buffer start:1 for:buffer size flags:0
!

sendTo:anAddressBuffer buffer:buffer start:startIndex for:count
    "send datagramm data - fetch address of destination host from
     anAddressBuffer, data from aDataBuffer.
     Both must be ByteArray-like. The bytes in the addressBuffer must
     be a valid address for my domain (i.e. for inet, a 4-byte byteArray).
     Return the number of bytes transmitted, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable.
     Flags is currently ignored; it is there for ST-80 compatibility."

    ^ self sendTo:anAddressBuffer buffer:buffer start:startIndex for:count flags:0
!

sendTo:anAddressBuffer buffer:aDataBuffer start:startIndex for:nBytes flags:flags
    "send datagramm data - fetch address of destination host from
     anAddressBuffer, data from aDataBuffer starting at startIndex,
     sending count bytes.
     Both must be ByteArray-like. The bytes in the addressBuffer must
     be a valid address for my domain (i.e. for inet, a 4-byte byteArray).
     Return the number of bytes transmitted, or a negative number on error.
     On error, the unix error code is left in the lastErrorNumber
     instance variable."

    |domainClass addr|

    domainClass := self class socketAddressClassForDomain:domain.
    domainClass isNil ifTrue:[
	^ self error:'invalid (unsupported) domain'.
    ].

    (anAddressBuffer isKindOf:SocketAddress) ifTrue:[
	addr := anAddressBuffer.
    ] ifFalse:[
	anAddressBuffer isByteArray ifFalse:[
	    ^ self error:'bad socketAddress argument'
	].
	addr := domainClass hostAddress:anAddressBuffer.
    ].
%{
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);

    if ((fp != nil)
     && __isSmallInteger(startIndex)
     && __isSmallInteger(nBytes)) {
	SOCKET sock;
	int objSize;
	struct sockaddr *sockaddr_ptr;
	union sockaddr_u sa;
	int alen = 0;
	int sockAddrOffs, sockaddr_size;
	int n;
	char *extPtr;
	int _flags = 0;
	int offs;
	unsigned long norder;
	unsigned char *buffer;
	unsigned char *allocatedBuffer;

	_flags = __longIntVal(flags);
	sock = SOCKET_FROM_FILE_OBJECT(fp);

	if (! __isBytes(addr)) {
	    sockaddr_size = 0;
	    sockaddr_ptr = (struct sockaddr *)0;
	} else {
	    int nIndex;
	    OBJ cls;

	    sockAddrOffs = 0;
	    if ((cls = __qClass(addr)) != @global(ByteArray))
		sockAddrOffs += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    nIndex = __qSize(addr) - OHDR_SIZE;
	    sockaddr_size = nIndex - sockAddrOffs;
	    if (sockaddr_size > sizeof(sa)) {
		console_fprintf(stderr, "Socket [warning]: bad socketAddr\n");
		goto bad;
	    }
	    bcopy((__byteArrayVal(addr) + sockAddrOffs), &sa, sockaddr_size);
	    sockaddr_ptr = (struct sockaddr *)(&sa);
	}

	if (! setupBufferParameters(aDataBuffer, startIndex, &extPtr, &offs, &objSize)) goto bad;
	if (__isSmallInteger(nBytes)) {
	    if (__intVal(nBytes) < objSize) {
		objSize = __intVal(nBytes);
	    }
	}

#ifdef DO_WRAP_CALLS
	if (extPtr) {
	    buffer = extPtr + offs;
	} else {
	    allocatedBuffer = buffer = (char *)malloc(objSize);
	    bcopy((char *)__InstPtr(aDataBuffer) + offs, allocatedBuffer, objSize);
	}

	do {
	    __threadErrno = 0;
	    n = STX_WSA_CALL6("sendto", sendto, sock, buffer, objSize, _flags, sockaddr_ptr, sockaddr_size);
	} while ((n < 0) && (__threadErrno == EINTR));

	if (allocatedBuffer) {
	    free(allocatedBuffer);
	}
#else
	__BEGIN_INTERRUPTABLE__
	do {
	    if (extPtr) {
		n = sendto(sock, extPtr + offs, objSize, _flags, sockaddr_ptr, sockaddr_size);
	    } else {
		n = sendto(sock, (char *)__InstPtr(aDataBuffer) + offs, objSize, _flags, sockaddr_ptr, sockaddr_size);
	    }
	} while ((n < 0) && (errno == EINTR));
	__END_INTERRUPTABLE__
#endif

	if (n < 0) {
	    __INST(lastErrorNumber) = __MKSMALLINT(errno);
	}
	RETURN (__MKSMALLINT(n));
    }
#endif
bad: ;
%}.
    "
     arrive here if you try to send from an invalid buffer
     (i.e. not ByteArray-like),
     or if the addressBuffer is nonNil AND not a ByteArray/String
     or if the addressBuffer is nonNil AND too small.
    "
    self primitiveFailed
! !

!Socket protectedMethodsFor:'low level'!

closeFile
    "low level close"

%{  /* NOCONTEXT */
#ifndef NO_SOCKET
    OBJ t;

    t = __INST(filePointer);
    if (t != nil) {
	FILE *fp;
	SOCKET sock;
	int fd;

	__INST(filePointer) = nil;
	fp = __FILEVal(t);
	fd = fileno(fp);
	sock = SOCKET_FROM_FD(fd);

# ifdef xxDO_WRAP_CALLS
	{ int ret;

	  do {
	    __threadErrno = 0;
	    ret = STX_C_CALL1("fclose", fclose, fp);
	  } while ((ret < 0) && (__threadErrno == EINTR));

#  ifdef WIN32
	  do {
	    __threadErrno = 0;
	    ret = STX_WSA_CALL1("closesocket", closesocket, sock);
	  } while ((ret < 0) && (__threadErrno == EINTR));
	  closesocket(sock);
#  endif
	}
# else /* !DO_WRAP_CALLS */

	DBGFPRINTF((stderr, "SOCKET: fflush %x (%d %d)\n", fp, fileno(fp), sock));
	fflush(fp);

#  if defined(CLOSESOCKET_BEFORE_FCLOSE)
	DBGFPRINTF((stderr, "SOCKET: closesocket (%d)\n", sock));
	closesocket(sock);
#  endif
	if ((@global(FileOpenTrace) == true) || __debugging__) {
	    console_fprintf(stderr, "SOCKET: fclose %x (%d %d)\n", fp, fileno(fp), sock);
	}
	fclose(fp);

#  if defined(CLOSESOCKET_AFTER_FCLOSE)
	DBGFPRINTF((stderr, "SOCKET: closesocket (%d)\n", sock));
	closesocket(sock);
#  endif
# endif /* !DO_WRAP_CALLS */
    }
#endif /* NO_SOCKET */
%}
! !

!Socket methodsFor:'low level'!

getSocketAdress
    "BAD SPELLING, of #getSocketAddress, kept for compatibility with swazoo"

    <resource: #obsolete>

    ^ self getSocketAddress
!

getSocketError
    "get the SO_ERROR form the socket, which indicates the
     result of an asynchronous operation"

%{
#ifndef NO_SOCKET
    OBJ fp;
    int err;

    fp = __INST(filePointer);
    if (fp == nil) {
	err = EBADF;
    } else {
	unsigned int sz;
	SOCKET sock;

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	sz = sizeof(err);
	if (getsockopt(sock, SOL_SOCKET, SO_ERROR, &err, &sz) < 0) {
# ifdef WIN32
	    errno = WSAGetLastError();
# endif
	    err = errno;
	}
    }

    RETURN(__MKSMALLINT(err));
#endif
%}
!

listenWithBacklog:aNumber
    <resource: #obsolete>
    "same as listenFor: - backward compatibility with old ST/X"

    ^ self listenFor:aNumber
!

pollingWaitForNewConnectionOrDataOnAny:otherConnections timeout:timeoutSeconds
    <resource: #obsolete>
    "stupid MSDOS does not support select on sockets (sigh).
     Must poll here."

    |millis newConnection|

    millis := timeoutSeconds * 1000.
    [millis > 0] whileTrue:[
	otherConnections size > 0 ifTrue:[
	    otherConnections do:[:aConnection |
		aConnection canReadWithoutBlocking ifTrue:[
		    ^ aConnection
		]
	    ].
	].
	newConnection := self blockingAccept.
	newConnection notNil ifTrue:[^ newConnection].
	Delay waitForMilliseconds:20.
	millis := millis - 20.
    ].
    ^ nil.
!

pollingWaitForNewConnectionWithTimeout:timeoutSeconds
    <resource: #obsolete>
    "stupid MSDOS does not support select on sockets (sigh).
     Must poll here."

    |millis newConnection|

    timeoutSeconds notNil ifTrue:[
	millis := timeoutSeconds * 1000.
    ].
    [millis isNil or:[millis > 0]] whileTrue:[
	newConnection := self blockingAccept.
	newConnection notNil ifTrue:[^ newConnection].
	Delay waitForMilliseconds:20.
	millis notNil ifTrue:[
	    millis := millis - 20.
	]
    ].
    ^ nil.
!

primAcceptOn:aSocket blocking:blocking
    "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.
     If blocking is true, the accept() syscall (and the whole smalltalk image)
     will block, until a connection is accepted.
     If blocking is false, this call will return immediately, if there is no connection pending."

    |serverSocketFd addr addrLen domainClass|

    filePointer notNil ifTrue:[
        ^ self errorAlreadyOpen
    ].

    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'
    ].

    domainClass := self class socketAddressClassForDomain:domain.
    domainClass isNil ifTrue:[
        ^ self error:'invalid (unsupported) domain'.
    ].
    addrLen := domainClass socketAddressSize.
    addr := domainClass new.

%{  /* STACK: 100000 */
#ifndef NO_SOCKET
    FILE *fp;
    int flags;
    SOCKET sock, newSock;
    union sockaddr_u sa;
    unsigned int alen, alen0;
    struct hostent *he ;
    char dotted[20] ;

    if (!__isSmallInteger(addrLen)) {
        DBGPRINTF(("SOCKET: bad addrLen\n"));
        RETURN (false);
    }
    alen0 = __intVal(addrLen);
    sock = SOCKET_FROM_FD(__intVal(serverSocketFd));

    if (blocking == false) {
# if defined(O_NONBLOCK) && defined(SET_NDELAY)
        flags = fcntl(sock, F_GETFL);
        fcntl(sock, F_SETFL, flags | O_NONBLOCK);
# endif
    }

# ifdef DO_WRAP_CALLS
    do {
        __threadErrno = 0;
        alen = alen0;
        newSock = STX_WSA_CALL3("accept", accept, sock, &sa, &alen);
    } while ((newSock < 0) && (__threadErrno == EINTR));
# else
    __BEGIN_INTERRUPTABLE__
    do {
        alen = alen0;
        newSock = accept(sock, (struct sockaddr *) &sa, &alen);
    } while ((newSock < 0) && (errno == EINTR));
    __END_INTERRUPTABLE__
# endif
    DBGFPRINTF((stderr, "SOCKET: accept newSock=%d\n", newSock));

    if (blocking == false) {
# if defined(O_NDELAY) && defined(SET_NDELAY)
        fcntl(sock, F_SETFL, flags);
# endif
    }

    if (newSock < 0) {
        DBGPRINTF(("SOCKET: accept call failed errno=%d\n", errno));
        __INST(lastErrorNumber) = __MKSMALLINT(errno);
        RETURN (false);
    }

    if (__isNonNilObject(addr)) {
        OBJ oClass;
        int nInstVars, nInstBytes, objSize;
        char *cp;

        oClass = __qClass(addr);
        if (! __isBytes(addr) ) {
            DBGPRINTF(("SOCKET: bad addr\n"));
            closesocket(newSock);
            RETURN (false);
        }

        nInstVars = __intVal(__ClassInstPtr(oClass)->c_ninstvars);
        nInstBytes = OHDR_SIZE + (nInstVars * sizeof(OBJ));
        objSize = __qSize(addr) - nInstBytes;
        cp = (char *)__InstPtr(addr) + nInstBytes;
        if (objSize < alen) {
            DBGPRINTF(("SOCKET: bad addr\n"));
            closesocket(newSock);
            RETURN (false);
        }

        /*
         * extract the partners address
         */
        bcopy((char *)&sa, cp, alen);
        addrLen = __MKSMALLINT(alen);
    }

    /*
     * make it a FILE *
     */
# ifdef WIN32
    {
        int _fd = _open_osfhandle(newSock, 0);
        fp = fdopen(_fd, "r+");
        DBGPRINTF(("SOCKET: sock=%d fd=%d fp=%x\n",newSock,_fd, fp));
    }
# else
    fp = fdopen(newSock, "r+");
# endif

    if (! fp) {
        DBGPRINTF(("SOCKET: fdopen call failed\n"));
        __INST(lastErrorNumber) = __MKSMALLINT(errno);
#  ifdef DO_WRAP_CALLS
        {
          int ret;
          do {
              __threadErrno = 0;
              ret = STX_WSA_CALL1("closesocket", closesocket, newSock);
          } while ((ret < 0) && (__threadErrno == EINTR));
        }
#  else
        closesocket(newSock);
#  endif
        DBGFPRINTF((stderr, "SOCKET: close (fdopen failed) (%d)\n", newSock));
        RETURN (false);
    }

    if ((@global(FileOpenTrace) == true) || __debugging__) {
# ifdef WIN32
        {
            HANDLE h;
            int _fd = fileno(fp);
            h = (HANDLE)_get_osfhandle(_fd);
            console_fprintf(stderr, "fdopen [Socket] -> %x (fd: %d) (H: %x)\n", fp, _fd, h);
        }
# else
        console_fprintf(stderr, "fdopen [Socket] -> %x (fd: %d)\n", fp, newSock);
# endif
    }

# ifdef BUGGY_STDIO_LIB
    setbuf(fp, NULL);
    __INST(buffered) = false;
# endif

# if 0
    // The original code was:
    __INST(filePointer) = __MKOBJ((INT)fp); __STORESELF(filePointer);
    // but for that, gcc generates wrong code, which loads self (volatile) into
    // a register (bp), then calls __MKOBJ, then stores indirect bp.
    // That is wrong if a scavenge occurs in MKOBJ, as bp is now still pointing to the old
    // object.
# endif
    {
        OBJ t;

        t = __MKOBJ(fp);
        __INST(filePointer) = t;
        __STORE(self, t);
    }
#endif /* not NO_SOCKET */
%}.
    mode := #readwrite.
    Lobby register:self.
    binary := false.
    port := aSocket port.

    addr notNil ifTrue:[
        peer := addr.
    ].

    ^ true
! !

!Socket protectedMethodsFor:'low level'!

setSocketOption:option argument:arg1 argument:arg2
    |ok|

%{  /* STACK: 32000 */
    OBJ fp = __INST(filePointer);

    if (fp != nil) {
	SOCKET sock;
	int opt = -1;
	int level = -1;
	int usize = -1;
	int ret;
	union u {
	    BOOL        u_bool;
	    int         u_int;
	    struct linger u_linger;
	} u;

	sock = SOCKET_FROM_FILE_OBJECT(fp);

# ifdef SO_BROADCAST
	if (option == @symbol(SO_BROADCAST)) {
	    /* Enables transmission and receipt of broadcast messages on the socket. */
	    opt = SO_BROADCAST;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_BROADCAST */

# ifdef SO_CONDITIONAL
#  if 0
	if (option == @symbol(SO_CONDITIONAL)) {
	    /* Enables sockets to delay the acknowledgment of a connection until after the WSAAccept condition function is called. */
	    opt = SO_CONDITIONAL;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
#  endif
# endif /* SO_CONDITIONAL */

# ifdef SO_DEBUG
	if (option == @symbol(SO_DEBUG)) {
	    /* Records debugging information. */
	    opt = SO_DEBUG;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_DEBUG */

# ifdef SO_DONTLINGER
	    if (option == @symbol(SO_DONTLINGER)) {
		/* Does not block close waiting for unsent data to be sent.
		   Setting this option is equivalent to setting SO_LINGER with l_onoff set to zero. */
		opt = SO_DONTLINGER;
		level = SOL_SOCKET;
		usize = sizeof(u.u_bool);
		if (arg1 == true) u.u_bool = TRUE;
		else if (arg1 == false) u.u_bool = FALSE;
		else goto argError;
	    }
# endif /* SO_DONTLINGER */

# ifdef SO_DONTROUTE
	if (option == @symbol(SO_DONTROUTE)) {
	    /* Does not route: sends directly to interface.
	       Succeeds but is ignored on AF_INET sockets;
	       fails on AF_INET6 sockets with WSAENOPROTOOPT.
	       Not supported on ATM sockets (results in an error). */
	    opt = SO_DONTROUTE;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_DONTROUTE */

# ifdef SO_KEEPALIVE
	if (option == @symbol(SO_KEEPALIVE)) {
	    /* Sends keep-alives. Not supported on ATM sockets (results in an error). */
	    opt = SO_KEEPALIVE;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_KEEPALIVE */

# ifdef SO_LINGER
	if (option == @symbol(SO_LINGER)) {
	    /* Lingers on close if unsent data is present. */
	    opt = SO_LINGER;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_linger);
	    if (arg1 == true) u.u_linger.l_onoff = TRUE;
	    else if (arg1 == false) u.u_linger.l_onoff = FALSE;
	    else goto argError;
	    if (arg2 == nil) u.u_linger.l_linger = 0;
	    else if (__isSmallInteger(arg2))u.u_linger.l_linger = __intVal(arg2);
	    else goto argError;
	    DBGPRINTF(("SOCKET: SO_LINGER %d %d\n", u.u_linger.l_onoff, u.u_linger.l_linger));
	}
# endif /* SO_LINGER */

# ifdef SO_OOBINLINE
	if (option == @symbol(SO_OOBINLINE)) {
	    /* Receives OOB data in the normal data stream. */
	    opt = SO_OOBINLINE;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_OOBINLINE */

# ifdef SO_RCVBUF
	if (option == @symbol(SO_RCVBUF)) {
	    /* Specifies the total per-socket buffer space reserved for receives.
	       This is unrelated to SO_MAX_MSG_SIZE or the size of a TCP window. */
	    opt = SO_RCVBUF;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_int);
	    if (__isSmallInteger(arg1))u.u_int = __intVal(arg1);
	    else goto argError;
	}
# endif /* SO_RCVBUF */

# ifdef SO_SNDBUF
	if (option == @symbol(SO_SNDBUF)) {
	    /* Specifies the total per-socket buffer space reserved for sends.
	       This is unrelated to SO_MAX_MSG_SIZE or the size of a TCP window. */
	    opt = SO_SNDBUF;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_int);
	    if (__isSmallInteger(arg1))u.u_int = __intVal(arg1);
	    else goto argError;
	}
# endif /* SO_SNDBUF */

# ifdef SO_REUSEADDR
	if (option == @symbol(SO_REUSEADDR)) {
	    /* Allows the socket to be bound to an address that is already in use.  */
	    opt = SO_REUSEADDR;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_OOBINLINE */

# ifdef SO_EXCLUSIVEADDRUSE
	if (option == @symbol(SO_EXCLUSIVEADDRUSE)) {
	    /* Enables a socket to be bound for exclusive access.
	       Does not require administrative privilege.  */
	    opt = SO_EXCLUSIVEADDRUSE;
	    level = SOL_SOCKET;
	    usize = sizeof(u.u_bool);
	    if (arg1 == true) u.u_bool = TRUE;
	    else if (arg1 == false) u.u_bool = FALSE;
	    else goto argError;
	}
# endif /* SO_OOBINLINE */

	if (usize == -1) goto argError;

	ok = ( setsockopt( sock, level, opt, &u, usize) >= 0) ? true : false;
    }
argError: ;

%}.
    ok isNil ifTrue:[
	self primitiveFailed
    ].
    ok ifFalse:[
	'setsocketoption failed' infoPrintCR.
    ].
! !

!Socket methodsFor:'low level'!

shutdown: howNum
    "shutDown the socket - inform it that no more I/O will be performed.
	 0 - read side   (no further reads)
	 1 - write side  (no further writes)
	 2 - both        (no further I/O at all)
     shutDown:2
	discards any pending data
	(as opposed to close, which might wait until data is delivered as set by LINGER)"

%{
#ifndef NO_SOCKET

    OBJ fp;

    fp = __INST(filePointer);
    if ((fp != nil) && __isSmallInteger(howNum)) {
	SOCKET sock;
	int ret;

	sock = SOCKET_FROM_FILE_OBJECT(fp);
# ifdef DO_WRAP_CALLS
	do {
	    __threadErrno = 0;
	    DBGFPRINTF((stderr, "SOCKET: shutDown...\n"));
	    ret = STX_WSA_CALL2("shutdown", shutdown, sock, __intVal(howNum));
	    DBGFPRINTF((stderr, "SOCKET: shutDown -> %d (%d)\n", ret, __threadErrno));
	} while ((ret < 0) && (__threadErrno == EINTR));
# else
	__BEGIN_INTERRUPTABLE__
	shutdown(sock, __intVal(howNum));
	__END_INTERRUPTABLE__
# endif
    }
#endif
%}.
! !

!Socket methodsFor:'printing & storing'!

printOn:aStream
    aStream nextPutAll:self className; nextPutAll:'(protocol='.
    protocol printOn:aStream.
    aStream nextPutAll:' port='.
    self port printOn:aStream.
    aStream nextPutAll:' peer='.
    peer printOn:aStream.
    aStream nextPut:$).
! !

!Socket methodsFor:'queries'!

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

    ^ domain
!

getFullSocketAddress
    "implemented for swazoo project (primitive code can't be loaded as extension)
     Answer my own address (I am bound to this address).
     Note that this address may change after a connect or accept."

    |error domainClass addr addrLen|

    filePointer isNil ifTrue:[
        ^ self errorNotOpen
    ].

    domainClass := self class socketAddressClassForDomain:domain.
    domainClass isNil ifTrue:[
        ^ self error:'invalid (unsupported) domain'.
    ].
    addrLen := domainClass socketAddressSize.
    addr := domainClass new.

%{
#ifndef NO_SOCKET
    OBJ fp = __INST(filePointer);
    SOCKET sock;
    int ret;
    union sockaddr_u sa;
    unsigned int alen, alen0;
    char *addrP;
    int addrObjSize, nAddrInstBytes;

    if (!__isSmallInteger(addrLen)) {
        DBGPRINTF(("SOCKET: bad addrLen\n"));
        error = @symbol(badArgument);
        goto err;
    }
    alen = alen0 = __intVal(addrLen);

    if (!__isNonNilObject(addr) || !__isBytes(addr)) {
        DBGPRINTF(("SOCKET: bad addr\n"));
        error = @symbol(badArgument);
        goto err;
    }

    {
        OBJ addrClass;
        int nAddrInstVars;

        addrClass = __qClass(addr);
        nAddrInstVars = __intVal(__ClassInstPtr(addrClass)->c_ninstvars);
        nAddrInstBytes = OHDR_SIZE + (nAddrInstVars * sizeof(OBJ));
        addrObjSize = __qSize(addr) - nAddrInstBytes;
        if (addrObjSize < alen0) {
            DBGPRINTF(("SOCKET: bad addr/alen\n"));
            error = @symbol(badArgument);
            goto err;
        }
    }

    sock = SOCKET_FROM_FILE_OBJECT(fp);
# ifdef WIN32
    __threadErrno = 0;
# endif
    ret = getsockname(sock, (struct sockaddr *)&sa, &alen);
    if (ret < 0) {
# ifdef WIN32
        errno = WSAGetLastError();
# endif
        DBGPRINTF(("SOCKET: getsocketname failed ret=%d errno=%d\n", ret, errno));
        error = __MKSMALLINT(errno);
        goto err;
    }

    if (addrObjSize < alen) {
        DBGPRINTF(("SOCKET: bad addr\n"));
        error = @symbol(badArgument);
        goto err;
    }

    addrP = (char *)__InstPtr(addr) + nAddrInstBytes;
    bcopy((char *)&sa, addrP, alen);

    addrLen = __MKSMALLINT(alen);

err:;
#else /* NO_SOCKET */
    error = @symbol(notImplemented);
#endif /* NO_SOCKET */
%}.
    error notNil ifTrue:[
        ^ self errorReporter reportOn:error
    ].
    ^ addr
!

getName
    "return the name; here, we return the ports name"

    ^ self port printString
!

getPeer
    "ST-80 compatibility: return an IPSocketAddress instance representing
     my hostname/port combination.
     If you are interested in the hostname, use getPeerName directly."

    ^ peer
!

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

    peerName isNil ifTrue:[
	peerName := self class peerNameFromDomain:domain peer:peer.
    ].
    ^ peerName
!

getSocketAddress
    "implemented for swazoo project primitive code cant load as extension
     answer my own address (I am bound to this address).
     Note that this address may change after connect or accept."

    ^ self getFullSocketAddress hostAddress
!

isActive
    "return true, if the receiver has a connection"

    ^ filePointer notNil
!

isConnected
    "return true, if the receiver has a connection"

    ^ self isActive
        and:[peer notNil]
!

port
    "return the port number (or name for unix-sockets) to which the socket is bound
     - so this is the local port."

"/    port isNil ifTrue:[
"/        port := self getFullSocketAddress port.
"/    ].

    ^ port
!

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

    ^ socketType
! !

!Socket methodsFor:'socket setup'!

domain:domainArg type:typeArg
    "set up socket with domain and type.
     This is a low level entry; no binding, listening or connect
     is done. Both arguments must be symbols from one of
     #inet,#unix, #appletalk, #x25 .. and #stream, #datagram, #raw resp."

    ^ self domain:domainArg type:typeArg protocol:0 reuseAddress:true
!

domain:domainArg type:typeArg protocol:protocolNumber
    "set up socket with domain, type and protocol number.
     This is a low level entry; no binding, listening or connect
     is done. Both arguments must be symbols from one of
     #inet,#unix, #appletalk, #x25 .. and #stream, #datagram, #raw resp."

    ^ self domain:domainArg type:typeArg protocol:protocolNumber reuseAddress:true

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

domain:domainArg type:typeArg protocol:protocolNumber reuseAddress:reuse
    "set up socket with domain, type and protocol number.
     This is a low level entry; no binding, listening or connect
     is done. Both arguments must be symbols from one of
     #inet,#unix, #appletalk, #x25 .. and #stream, #datagram, #raw resp.

     The reuse boolean argument controls if the SO_REUSEADDR socket option
     is to be set (to avoid the 'bind: address in use' error)."

    |domainName domainCode typeCode error|

    filePointer notNil ifTrue:[
	^ self errorAlreadyOpen
    ].
    domainName := SocketAddress domainCodeFromName:domainArg.
    domainCode := OperatingSystem domainCodeOf:domainName.
    typeCode := OperatingSystem socketTypeCodeOf:typeArg.
%{

#ifndef NO_SOCKET
    FILE *fp;
    int dom, typ, pf, proto = 0;
    int on = 1;
    SOCKET sock;

    if (! __isSmallInteger(domainCode)) {
	error = @symbol(badArgument1);
	goto out;
    }
    if (! __isSmallInteger(typeCode)) {
	error = @symbol(badArgument2);
	goto out;
    }
    if (protocolNumber != nil) {
	if (!__isSmallInteger(protocolNumber)) {
	    error = @symbol(badArgument3);
	    goto out;
	}
	proto = __intVal(protocolNumber);
    }


    /*
     * get address and protocol-family
     */
    dom = __intVal(domainCode);
    typ = __intVal(typeCode);

# ifdef SOCKET_BLOCKS
#  ifdef DO_WRAP_CALLS
    do {
	__threadErrno = 0;
	sock = STX_WSA_CALL3("socket", socket, dom, typ, proto);
    } while ((sock < 0) && (__threadErrno == EINTR));
#  else
    __BEGIN_INTERRUPTABLE__
    do {
	DBGPRINTF(("SOCKET: opening socket domain=%d type=%d proto=%d\n", dom, typ, proto));
	sock = socket(dom, typ, proto);
#   if defined(EPROTONOSUPPORT) /* for SGI */
	if ((proto != 0) && (sock < 0) && (errno == EPROTONOSUPPORT)) {
	    DBGPRINTF(("SOCKET: retry with UNSPEC protocol\n"));
	    proto = 0;
	    sock = socket(dom, typ, 0);
	}
#   endif
    } while ((sock < 0) && (errno == EINTR));
    __END_INTERRUPTABLE__
#  endif
# else
    sock = socket(dom, typ, proto);
#  if defined(EPROTONOSUPPORT) /* for SGI */
    if ((proto != 0) && (sock < 0) && (errno == EPROTONOSUPPORT)) {
	DBGPRINTF(("SOCKET: retry with UNSPEC protocol\n"));
	proto = 0;
	sock = socket(dom, typ, 0);
    }
#  endif
# endif

    DBGFPRINTF((stderr, "SOCKET: create newSock=%d\n", sock));

# ifdef WIN32
    if (sock == INVALID_SOCKET)
# else
    if (sock < 0)
# endif
    {
	DBGPRINTF(("SOCKET: socket(dom=%d typ=%d proto=%d) call failed errno=%d\n", dom, typ, proto, errno));
	__INST(lastErrorNumber) = __MKSMALLINT(errno);
    } else {
# ifdef SO_REUSEADDR
	if (reuse == true) {
	    DBGPRINTF(("SOCKET: setsockopt - SO_REUSEADDR\n"));
	    if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &on, sizeof (on)) < 0) {
		DBGPRINTF(("SOCKET: setsockopt - SO_REUSEADDR failed\n"));
	    }
	}
# endif /* SO_REUSEADDR */

# ifdef SET_LINGER_WHEN_CREATING_SOCKET
#  ifdef SO_LINGER
	{
	    struct linger l;

	    l.l_onoff = 1;
	    l.l_linger = 30;
	    setsockopt( sock, SOL_SOCKET, SO_LINGER, &l, sizeof(l));
	}
#  endif
# endif
# ifdef WIN32
	/*
	 * make it blocking
	 */
	{
	    int zero = 0;

	    ioctlsocket(sock, FIONBIO, &zero);
	}
# endif
	/*
	 * make it a FILE *
	 */
# ifdef WIN32
	{
	    int _fd = _open_osfhandle(sock, 0);
	    fp = fdopen(_fd, "r+");
	    DBGPRINTF(("SOCKET: sock=%d fd=%d fp=%x\n",sock,_fd, fp));
	}
# else
	fp = fdopen(sock, "r+");
# endif
	if (! fp) {
	    DBGPRINTF(("SOCKET: fdopen call failed\n"));
	    __INST(lastErrorNumber) = __MKSMALLINT(errno);
# ifdef DO_WRAP_CALLS
	    { int ret;

	      do {
		__threadErrno = 0;
		ret = STX_WSA_CALL1("closesocket", closesocket, sock);
	      } while ((ret < 0) && (__threadErrno == EINTR));
	    }
# else
	    __BEGIN_INTERRUPTABLE__
	    closesocket(sock);
	    DBGFPRINTF((stderr, "SOCKET: fdopen failed (%d)\n", sock));
	    __END_INTERRUPTABLE__
# endif
	} else {
	    if ((@global(FileOpenTrace) == true) || __debugging__) {
		console_fprintf(stderr, "fdopen [Socket] -> %x\n", fp);
	    }

# if 0
	    // The original code was:
	    __INST(filePointer) = __MKOBJ((INT)fp); __STORESELF(filePointer);
	    // but for that, gcc generates wrong code, which loads self (volatile) into
	    // a register (bp), then calls __MKOBJ, then stores indirect bp.
	    // That is wrong if a scavenge occurs in MKOBJ, as bp is now still pointing to the old
	    // object.
# endif
	    {
		OBJ t;

		t = __MKOBJ(fp);
		__INST(filePointer) = t;
		__STORE(self, t);
	    }
	}
    }
#endif
out:;
%}.

    "all ok?"
    filePointer notNil ifTrue:[
	domain := domainArg.
	socketType := typeArg.
	Lobby register:self.
    ] ifFalse:[
	error notNil ifTrue:[
	    ^ self primitiveFailed:error.
	].
	^ self openError
    ].

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

!Socket methodsFor:'specials'!

receiveBufferSize
    "get the send buffer size - for special applications only.
     Not all operatingSystems offer this functionality
     (returns nil, if unsupported)"

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(SO_RCVBUF) && defined(SOL_SOCKET)
    {
	OBJ fp = __INST(filePointer);
	SOCKET sock;
	int opt;
	unsigned int size;

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	if (getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&opt, &size) >= 0) {
	    RETURN( __MKSMALLINT(opt) );
	}
    }
#endif
%}.
    ^ nil
!

receiveBufferSize:size
    "set the receive buffer size - for special applications only.
     Not all operatingSystems offer this functionality
     (returns false, if unsupported)"

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(SO_RCVBUF) && defined(SOL_SOCKET)
    if (__isSmallInteger(size)) {
	OBJ fp = __INST(filePointer);
	SOCKET sock;
	int opt;

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	opt = __intVal(size);
	if (setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&opt, sizeof(int)) >= 0 ) {
	    RETURN(true);
	}
    }
#endif
%}.
    ^ false
!

receiveTimeout
    "get the receive timeout in millis - for special applications only.
     Not all operatingSystems offer this functionality
     (returns nil, if unsupported)"

    |millis|

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(SO_RCVTIMEO) && defined(SOL_SOCKET)
    {
	OBJ fp = __INST(filePointer);
	int sock;
	int len;
	int __millis;
	struct timeval tv = {0, 0};

	sock = fileno(__FILEVal(fp));
	len = sizeof(struct timeval);
	if (getsockopt(sock, SOL_SOCKET, SO_RCVTIMEO, (void *)&tv, &len) == 0) {
	    __millis = (tv.tv_sec * 1000) + (tv.tv_usec / 1000);
	    millis = __mkSmallInteger(__millis);
# if 0
	    console_fprintf(stderr, "getsockopt -> s:%d us:%d -> millis:%d\n", tv.tv_sec, tv.tv_usec, __millis);
# endif
	} else {
	    console_fprintf(stderr, "Socket [warning]: getsockopt %d failed; errno=%d\n", sock, errno);
	}
    }
#endif
%}.
    millis notNil ifTrue:[^ millis / 1000 ].
    ^ nil
!

receiveTimeout:seconds
    "set the receive timeout - for special applications only.
     Not all operatingSystems offer this functionality
     (returns false, if unsupported)"

    |millis|

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
    millis := (seconds * 1000) rounded.
%{
#if defined(SO_RCVTIMEO) && defined(SOL_SOCKET)
    if (__isSmallInteger(millis)) {
	OBJ fp = __INST(filePointer);
	int sock;
	int __millis = __intVal(millis);
	struct timeval tv = {0, 0};

	sock = fileno(__FILEVal(fp));
	tv.tv_sec = __millis / 1000;
	tv.tv_usec = (__millis % 1000) * 1000;
# if 0
	console_fprintf(stderr, "setsockopt -> millis:%d -> s:%d us:%d \n", __millis, tv.tv_sec, tv.tv_usec);
# endif
	if (setsockopt(sock, SOL_SOCKET, SO_RCVTIMEO, (void *)&tv, sizeof(struct timeval)) == 0) {
	    RETURN(true);
	}
	console_fprintf(stderr, "Socket [warning]: setsockopt %d failed; errno=%d\n", sock, errno);
    }
#endif
%}.
    ^ false
!

sendBufferSize
    "get the send buffer size - for special applications only.
     Not all operatingSystems offer this functionality
     (returns nil, if unsupported)"

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(SO_SNDBUF) && defined(SOL_SOCKET)
    {
	OBJ fp = __INST(filePointer);
	SOCKET sock;
	int opt;
	unsigned int size;

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	if (getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&opt, &size) >= 0) {
	    RETURN( __MKSMALLINT(opt) );
	}
    }
#endif
%}.
    ^ nil
!

sendBufferSize:size
    "set the send buffer size - for special applications only.
     Not all operatingSystems offer this functionality
     (returns false, if unsupported)"

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(SO_SNDBUF) && defined(SOL_SOCKET)
    if (__isSmallInteger(size)) {
	OBJ fp = __INST(filePointer);
	SOCKET sock;
	int opt;

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	opt = __intVal(size);
	if (setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&opt, sizeof(int)) >= 0) {
	    RETURN(true);
	}
    }
#endif
%}.
    ^ false
!

sendTimeout
    "get the send timeout in millis - for special applications only.
     Not all operatingSystems offer this functionality
     (returns nil, if unsupported)"

    |millis|

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(SO_SNDTIMEO) && defined(SOL_SOCKET)
    {
	OBJ fp = __INST(filePointer);
	int sock;
	int len;
	int __millis;
	struct timeval tv = {0, 0};

	sock = fileno(__FILEVal(fp));
	len = sizeof(struct timeval);
	if (getsockopt(sock, SOL_SOCKET, SO_SNDTIMEO, (void *)&tv, &len) == 0) {
	    __millis = (tv.tv_sec * 1000) + (tv.tv_usec / 1000);
	    millis = __mkSmallInteger(__millis);
# if 0
	    console_fprintf(stderr, "getsockopt -> s:%d us:%d -> millis:%d\n", tv.tv_sec, tv.tv_usec, __millis);
# endif
	} else {
	    console_fprintf(stderr, "Socket [warning]: getsockopt %d failed; errno=%d\n", sock, errno);
	}
    }
#endif
%}.
    millis notNil ifTrue:[^ millis / 1000 ].
    ^ nil
!

sendTimeout:seconds
    "set the send timeout - for special applications only.
     Not all operatingSystems offer this functionality
     (returns false, if unsupported)"

    |millis|

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
    millis := (seconds * 1000) rounded.
%{
#if defined(SO_SNDTIMEO) && defined(SOL_SOCKET)
    if (__isSmallInteger(millis)) {
	OBJ fp = __INST(filePointer);
	int sock;
	int __millis = __intVal(millis);
	struct timeval tv = {0, 0};

	sock = fileno(__FILEVal(fp));
	tv.tv_sec = __millis / 1000;
	tv.tv_usec = (__millis % 1000) * 1000;
# if 0
	console_fprintf(stderr, "setsockopt -> millis:%d -> s:%d us:%d \n", __millis, tv.tv_sec, tv.tv_usec);
# endif
	if (setsockopt(sock, SOL_SOCKET, SO_SNDTIMEO, (void *)&tv, sizeof(struct timeval)) == 0) {
	    RETURN(true);
	}
	console_fprintf(stderr, "Socket [warning]: setsockopt %d failed; errno=%d\n", sock, errno);
    }
#endif
%}.
    ^ false

!

setTCPCork:aBoolean
    "enable/disable TCP_CORK (do-not-send-partial-frames)
     For special applications only.
     Not all OperatingSystems offer this functionality
     (returns false, if unsupported)"

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(IPPROTO_TCP) && defined(TCP_CORK)
    int onOff = (aBoolean == true);

    if ((aBoolean == true) || (aBoolean == false)) {
	OBJ fp = __INST(filePointer);
	SOCKET sock;
	int onOff = (aBoolean == true);

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	if (setsockopt(sock, IPPROTO_TCP, TCP_CORK, (char *)&onOff, sizeof(int)) >= 0) {
	    RETURN(true);
	}
    }
#endif
%}.
    ^ false
!

setTCPNoDelay:aBoolean
    "enable/disable TCP_NODELAY (i.e. disable/enable the Nagle algorithm)
     For special applications only.
     Not all OperatingSystems offer this functionality
     (returns false, if unsupported)"

    filePointer isNil ifTrue:[
	^ self errorNotOpen
    ].
%{
#if defined(IPPROTO_TCP) && defined(TCP_NODELAY)
    int onOff = (aBoolean == true);

    if ((aBoolean == true) || (aBoolean == false)) {
	OBJ fp = __INST(filePointer);
	SOCKET sock;
	int onOff = (aBoolean == true);

	sock = SOCKET_FROM_FILE_OBJECT(fp);
	if (setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&onOff, sizeof(int)) >= 0) {
	    RETURN(true);
	}
    }
#endif
%}.
    ^ false
! !

!Socket methodsFor:'waiting'!

waitForNewConnectionOrDataOnAny:otherConnections timeout:timeoutSeconds
    "suspend the current process, until either a new connection comes
     in at the receiver, or data arrives on any of the otherConnections.
     For a new connection, an accept is performed and the new socket is returned.
     For an old connection, that socket is returned.
     In any case, the caller gets a socket to operate on as return value,
     or nil, if a timeout occured.
     This method implements the inner wait-primitive of a multi-connection
     server application."


    |wasBlocked sema|

    "first, a quick check if data is already available"
    self canReadWithoutBlocking ifTrue:[
	^ self accept.
    ].
    otherConnections do:[:aConnection |
	aConnection canReadWithoutBlocking ifTrue:[
	    ^ aConnection
	]
    ].

    [
	"check again - prevent incoming interrupts from disturbing our setup"
	wasBlocked := OperatingSystem blockInterrupts.

	self canReadWithoutBlocking ifTrue:[
	    ^ self accept.
	].
	otherConnections do:[:aConnection |
	    aConnection canReadWithoutBlocking ifTrue:[
		^ aConnection
	    ]
	].

	"nope - must wait"
	sema := Semaphore new name:'multiReadWait'.
	otherConnections do:[:aConnection |
	    Processor signal:sema onInput:(aConnection fileDescriptor).
	].
	Processor signal:sema onInput:(self fileDescriptor).
	timeoutSeconds notNil ifTrue:[
	    Processor signal:sema afterSeconds:timeoutSeconds
	].
	Processor activeProcess state:#ioWait.
	sema wait.
    ] ensure:[
	sema notNil ifTrue:[Processor disableSemaphore:sema].
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ].

    "see who it was ..."
    self canReadWithoutBlocking ifTrue:[
	^ self accept.
    ].
    otherConnections do:[:aConnection |
	aConnection canReadWithoutBlocking ifTrue:[
	    ^ aConnection
	]
    ].

    "none - a timeout"
    ^ nil
!

waitForNewConnectionWithTimeout:timeoutSeconds
    "suspend the current process, until a new connection comes
     in at the receiver or a timeout occurs.
     For a new connection, an accept is performed and the new socket is returned.
     Returns nil, if a timeout occured.
     This method implements the inner wait-primitive of a single-connection
     server application."

    (self readWaitWithTimeout:timeoutSeconds) ifTrue:[
	"a timeout occurred - no connection within timeout"
	^ nil
    ].
    ^ self accept.
! !

!Socket class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/Socket.st,v 1.243 2008-03-28 12:47:59 stefan Exp $'
! !