"======================================================================
|
|   Socket wrapper class
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


AbstractSocket subclass: #Socket
	  instanceVariableNames: 'lookahead readBuffer writeBuffer'
	  classVariableNames: 'Ports ReadBufferSize WriteBufferSize'
	  poolDictionaries: ''
	  category: 'Sockets-Streams'
!

!Socket class methodsFor: 'tests'!

microTest
    "Extremely small test (try to receive SMTP header)"

    | s |
    s := Socket remote: IPAddress anyLocalAddress port: 25.
    (s upTo: Character cr) printNl.
    s close
!

tweakedLoopbackTest
    "Send data from one socket to another on the local machine, trying to avoid
     buffering overhead.  Tests most of the socket primitives.  Comparison of
     the results of loopbackTest and tweakedLoopbackTest should give a measure
     of the overhead of buffering when sending/receiving large quantities of
     data."

    ^self loopbackTest: #(5000 4000)
!

loopbackTest
    ^self loopbackTest: nil
!

loopbackTest: bufferSizes
    "Send data from one socket to another on the local machine. Tests most of the
     socket primitives."

    | queue server client bytesToSend sendBuf bytesSent
      bytesReceived t extraBytes timeout process |

    Transcript
	cr; show: 'starting loopback test'; cr;
	show: '---------- Connecting ----------'; cr.

    queue := ServerSocket port: 54321.
    client := Socket remote: IPAddress loopbackHost port: 54321.

    bufferSizes isNil ifFalse: [
	client
	    readBufferSize: (bufferSizes at: 1);
	    writeBufferSize: (bufferSizes at: 2)
    ].

    timeout := false.
    process := [
        (Delay forMilliseconds: Socket timeout) wait.
        timeout := true
    ] fork.
    [  timeout ifTrue: [ self error: 'could not establish connection' ].
       (server := queue accept) isNil ] whileTrue: [ Processor yield ].

    process terminate.
    Transcript show: 'connection established'; cr.

    bytesToSend := 5000000.
    sendBuf := String new: 4000 withAll: $x.
    bytesSent := bytesReceived := 0.
    t := Time millisecondsToRun: [
	[
	    server nextPutAll: sendBuf; flush.
	    bytesSent := bytesSent + sendBuf size.
	    [ client available ] whileTrue: [
		client fill.
		bytesReceived := bytesReceived +
		    client bufferContents size.
	    ].
	    (bytesSent >= bytesToSend) and: [bytesReceived = bytesSent]
	] whileFalse
    ].

    Transcript show: 'closing connection'; cr.
    extraBytes := client bufferContents size.
    server close.
    extraBytes > 0 ifTrue: [
	Transcript show: ' *** received ', extraBytes size printString, ' extra bytes ***'; cr.
    ].
    client close.
    queue close.
    Transcript 
	show: '---------- Connection Closed ----------'; cr;
	show: 'loopback test done; ', (t / 1000.0) printString, ' seconds'; cr;
	show: ((bytesToSend asFloat / t) roundTo: 0.01) printString;
	showCr: ' kBytes/sec'.
!

producerConsumerTest
    "Send data from one socket to another on the local machine. Tests most of the
     socket primitives and works with different processes."

    | bytesToSend bytesSent bytesReceived t server client queue sema
      producer consumer |

    Transcript
	cr; show: 'starting loopback test'; cr;
	show: '---------- Connecting ----------'; cr.

    sema := Semaphore new.
    bytesToSend := 5000000.
    bytesSent := bytesReceived := 0.

    t := Time millisecondsToRun: [
	producer := [
            | timeout process sendBuf |
	    queue := ServerSocket port: 54321.

	    timeout := false.
	    process := [
		(Delay forMilliseconds: Socket timeout) wait.
		timeout := true
	    ] fork.
	    [
		timeout ifTrue: [ self error: 'could not establish connection' ].
		(server := queue accept) isNil
	    ] whileTrue: [ Processor yield ].
	    process terminate.

	    Transcript show: 'connection established'; cr.
	    sendBuf := String new: 4000 withAll: $x.
	    [
		server nextPutAll: sendBuf; flush.
		bytesSent := bytesSent + sendBuf size.
		(bytesSent >= bytesToSend)
	    ] whileFalse: [ Processor yield ].
	    sema signal.
	] fork.

	consumer := [
	    client := Socket remote: IPAddress loopbackHost port: 54321.
	    [
		[ client available ] whileTrue: [
		    client fill.
		    bytesReceived := bytesReceived + client bufferContents size.
		].
		(bytesSent >= bytesToSend) and: [bytesReceived = bytesSent]
	    ] whileFalse: [ Processor yield ].
	    sema signal.
	] fork.

	sema wait.
	sema wait.
    ].
    Transcript show: 'closing connection'; cr.
    server close.
    client close.
    queue close.
    Transcript 
	show: '---------- Connection Closed ----------'; cr;
	show: 'loopback test done; ', (t / 1000.0) printString, ' seconds'; cr;
	show: ((bytesToSend asFloat / t) roundTo: 0.01) printString;
	showCr: ' kBytes/sec'.
!

sendTest
    "Send data to the 'discard' socket of an American host."
    ^self sendTest: 'create.ucsb.edu'
!

sendTest: host
    "Send data to the 'discard' socket of the given host. Tests the speed of
     one-way data transfers across the network to the given host. Note that
     many hosts do not run a discard server."
    "Socket sendTest: 'localhost'"

    | sock bytesToSend sendBuf bytesSent t |
    Transcript cr; show: 'starting send test'; cr.
    Transcript show: '---------- Connecting ----------'; cr.
    sock := Socket remote: host port: Socket portDiscard.
    Transcript show: 'connection established; sending data'; cr.

    bytesToSend := 100000.
    sendBuf := String new: 5000 withAll: $x.
    bytesSent := 0.
    t := Time millisecondsToRun: [
	[bytesSent < bytesToSend] whileTrue: [
	    sock nextPutAll: sendBuf; flush.
	    bytesSent := bytesSent + sendBuf size.
	]
    ].
    sock close.
    Transcript 
	show: '---------- Connection Closed ----------'; cr;
	show: 'send test done; time = ', t printString; cr;
	show: ((bytesToSend asFloat / t) roundTo: 0.01) printString;
	showCr: ' kBytes/sec'.
! !

!Socket class methodsFor: 'well known ports'!

portEcho	   ^7!
portDiscard	   ^9!
portSystat	   ^11!
portDayTime	   ^13!
portNetStat	   ^15!
portFTP		   ^21!
portTelnet	   ^23!
portSMTP	   ^25!
portTimeServer     ^37!
portDNS		   ^42!
portWhois	   ^43!
portGopher	   ^70!
portFinger	   ^79!
portHTTP	   ^80!
portPOP3	   ^110!
portNNTP	   ^119!
portExecServer     ^512!
portLoginServer    ^513!
portCmdServer      ^514!
portKerberosIV	   ^750!
portReserved       ^1024!
portUserReserved   ^5000!

defaultPortAt: protocol
    ^Ports at: protocol
!

defaultPortAt: protocol ifAbsent: port
    ^Ports at: protocol ifAbsent: port
!

defaultPortAt: protocol put: port
    ^Ports at: protocol put: port
!

initialize
    self defaultImplementationClass: TCPSocketImpl.
    self readBufferSize: 1024; writeBufferSize: 256.
    Ports := Dictionary new
	at: 'ftp' put: 21;
	at: 'telnet' put: 23;
	at: 'smtp' put: 25;
	at: 'dns' put: 42;
	at: 'whois' put: 43;
	at: 'finger' put: 79;
	at: 'http' put: 80;
	at: 'pop3' put: 110;
	at: 'nntp' put: 119;
	at: 'kerberos4' put: 750;
	yourself
! !

!Socket class methodsFor: 'accessing'!

readBufferSize
    ^ReadBufferSize
!

readBufferSize: anInteger
    ReadBufferSize := anInteger
!

writeBufferSize
    ^WriteBufferSize
!

writeBufferSize: anInteger
    WriteBufferSize := anInteger
! !

!Socket class methodsFor: 'instance creation'!

remote: ipAddressOrString port: remotePort
    ^self
	remote: ipAddressOrString
	port: remotePort
	local: nil
	port: 0
!

remote: ipAddressOrString port: remotePort local: ipAddress port: localPort
    | ipAddr |
    ipAddr := ipAddressOrString isString
	ifTrue: [ IPAddress byName: ipAddressOrString ]
	ifFalse: [ ipAddressOrString ].

    ((remotePort < 0) | (remotePort > 16rFFFF) |
    (localPort < 0) | (localPort > 16rFFFF)) 
	ifTrue: [ self error: 'port out of range' ].

    ^self new
	remote: ipAddressOrString
	port: remotePort
	local: ipAddress
	port: localPort
! !

!Socket methodsFor: 'accessing'!

address
    ^self remoteAddress
!

port
    ^self remotePort
!

remoteAddress
    ^self implementation remoteAddress
!

remotePort
    ^self implementation remotePort
!

soLinger
    ^self implementation soLinger
!

soLinger: linger
    ^self implementation soLinger: linger
!

soLingerOff
    ^self implementation soLinger: nil
!

species
    ^String
!

tcpNoDelay
    ^self implementation tcpNoDelay
!

tcpNoDelay: tcpNoDelay
    ^self implementation tcpNoDelay: tcpNoDelay
! !

!Socket methodsFor: 'printing'!

printOn: aStream
    aStream
	print: self class;
	nextPutAll: '[local ';
	print: self localAddress;
	nextPut: $: ;
	print: self localPort;
	nextPutAll: ', remote ';
	print: self remoteAddress;
	nextPut: $: ;
	print: self remotePort;
	nextPut: $]
! !

!Socket methodsFor: 'private'!

remote: ipAddressOrString port: remotePort local: ipAddress port: localPort
    | remoteAddr |
    self implementation create.

    ipAddress isNil ifFalse: [
	self implementation bindTo: ipAddress port: localPort
    ].

    remoteAddr := ipAddressOrString isString
	ifTrue: [ IPAddress byName: ipAddressOrString ]
	ifFalse: [ ipAddressOrString ].

    self implementation connectTo: remoteAddr port: remotePort
!

species
    ^String
! !

!Socket methodsFor: 'stream protocol'!

atEnd
    "Force creation of the read buffer"
    ^self peek isNil
!

available
    ^(self hasReadBuffer and: [ self readBuffer notEmpty ])
	or: [ super available ]
!

bufferContents
    | result |
    result := self readBuffer bufferContents.
    lookahead isNil ifFalse: [
	result := lookahead asString, result.
	lookahead := nil.
    ].
    ^result
!
    
close
    super close.
    self deleteBuffers
!

fill
    self readBuffer fill
!

flush
    self writeBuffer flush
!

isPeerAlive
    ^self readBuffer notNil
!

next
    | result |
    lookahead isNil ifTrue: [ ^self readBuffer next ].
    result := lookahead.
    lookahead := nil.
    ^result
!

next: count
    | result |
    lookahead isNil ifTrue: [ ^self readBuffer next: count ].
    result := (String with: lookahead), (self readBuffer next: count - 1).
    lookahead := nil.
    ^result
!

nextPut: byte
    "Bit-bucket when the socket is closed"
    self writeBuffer isNil ifTrue: [ ^self ].
    self writeBuffer nextPut: byte
!

nextPutAll: aByteArray
    "Bit-bucket when the socket is closed"
    self writeBuffer isNil ifTrue: [ ^self ].
    self writeBuffer nextPutAll: aByteArray
!

peek
    lookahead isNil ifTrue: [
	self readBuffer isNil ifTrue: [ ^nil ].
	self readBuffer atEnd ifTrue: [ ^nil ].
	lookahead := self readBuffer next ].
    ^lookahead
!

peekFor: anObject
    lookahead isNil ifTrue: [
	self readBuffer isNil ifTrue: [ ^false ].
	self readBuffer atEnd ifTrue: [ ^false ].
	lookahead := self readBuffer next ].
    ^lookahead = anObject
        ifTrue: [ lookahead := nil. true ]
        ifFalse: [ false ]
!

readBufferSize: size
    readBuffer isNil ifTrue: [ ^self ].
    (self hasReadBuffer and: [ readBuffer notEmpty ])
	ifTrue: [ self error: 'read buffer must be empty before changing its size' ].

    readBuffer := self newReadBuffer: size.
!

writeBufferSize: size
    writeBuffer isNil ifTrue: [ ^self ].
    self hasWriteBuffer ifTrue: [ writeBuffer flush ].
    writeBuffer := self newWriteBuffer: size.
! !

!Socket methodsFor: 'private - buffering'!

deleteBuffers
    readBuffer := writeBuffer := nil.
!

noBufferFlag
    "Value that means `lazily initialize the readBuffer and writeBuffer'."
    ^0
!

hasReadBuffer
    ^readBuffer ~~ self noBufferFlag
!

hasWriteBuffer
    ^writeBuffer ~~ self noBufferFlag
!

initialize: implementation
    super initialize: implementation.
    readBuffer := writeBuffer := self noBufferFlag.
!

newReadBuffer: size
    ^(ReadBuffer on: (String new: size))
	fillBlock: [ :data :size || alive num |
	    alive := true.
	    self
		waitUntil: [
		    self implementation canRead 
			ifFalse: [ (alive := self implementation isOpen) not ]
			ifTrue: [ (num := self implementation read: data numBytes: size) > 0 ]
                ]
		then: [
		    alive ifTrue: [ num ] ifFalse: [ self deleteBuffers. 0 ]
		]
		onTimeoutDo: [ self implementation close. self deleteBuffers. 0 ]
	]
!

newWriteBuffer: size
    ^(WriteBuffer on: (String new: size))
	flushBlock: [ :data :size || alive |
	    alive := true.
	    self
		waitUntil: [
		    self implementation canWrite or: [
			(alive := self implementation isOpen) not ] ]
		then: [
		    alive := alive and: [
			(self implementation write: data numBytes: size) > -1 ].

		    alive ifFalse: [ self deleteBuffers ]
		]
		onTimeoutDo: [ self implementation close. self deleteBuffers ]
	]
!

readBuffer
    readBuffer == self noBufferFlag
	ifTrue: [ readBuffer := self newReadBuffer: ReadBufferSize ].
    ^readBuffer
!

writeBuffer
    writeBuffer == self noBufferFlag
	ifTrue: [ writeBuffer := self newWriteBuffer: WriteBufferSize ].
    ^writeBuffer
! !
