Tcl Source Code

Artifact 98a275ee41821d6cd27d25ac6ac4a1078f00b628:

# -*- Tcl -*-

# Quickserver/client
#
# Copyright (c) 2001 Stuart Cassoff
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
# 2001/07/25
#
# Ver 0.1
#
#


proc server_connect {sock addr port} {
    puts "Server: Incoming connection on $sock"
    fileevent $sock writable [list firstwrite Server $sock]
}


proc client_connect {addr port} {
	puts "Client: Connecting to $addr:$port"
    set sock [socket -async $addr $port]
    fileevent $sock writable [list firstwrite Client $sock]
}



proc firstwrite {who sock} {
    fileevent $sock writable {}
    puts "$who: Firstwrite $sock"
    fconfigure $sock -blocking 0 -buffering none
    fileevent $sock readable [list reader $who $sock]
}



proc reader {who sock} {
    puts "$who: Reader $sock"
    set line [read $sock 11]
	puts "([string length $line]) ($line)"
    if {[eof $sock]} {
		puts "$who: Reader->eof $sock"
		close $sock
		set ::until_v_are_done 1
    }
}


proc start_server {} {
	global server_sock

	set server_sock [socket -server server_connect $::port]
}


proc start_client {} {
	if {[catch {set sock [socket -async $::addr $::port]}]} {
		puts err
	} else {
		fileevent $sock writable [list firstwrite Client $sock]
	}
}


#--------------------------------#

set port {11235}
set addr {localhost}
set until_v_are_done {0}

if {!$tcl_interactive} {
	if {$argc > 1} {
		if {$argc > 2} {
			start_server
		} else {
			start_client
		}
		vwait until_v_are_done
		catch {close $server_sock}
	} else {
		console show
	}
}


# EOF