Re: Help with sockets in block mode, please

On Feb 25, 10:49 pm, o...@xxxxxx wrote:
Hellow,

I am writing a chat server (DAEMON) in tcl, and i need block clients
sockets to decrease resource (CPU) usage for users with unstable
connections.

Daemon must process about 300-500 online connections and transfer
data.

I need to share connection (socket channel) for child proccess.

set proccessType [lindex $argv 0]

if {$proccessType == ""} {
puts "Daemon starting";

# Assepting connection
set mainSockets [socket -server acceptConnection 8888]

#
# Proccedures
#

proc resiveMessageFromChild {childId} {
if {[gets $childId line] < 0} {
catch {close $childId} ret
if ![string match "" $ret] {
puts "parent: gotline: child exited with \
error, ret = $ret, errorCode =
$::errorCode"
} else {
puts "parent: child: child exited ok"
}
return
}
puts "parent: got line from child: $line";
}

proc acceptConnection {socket remoteAddr remotePort} {

puts "New connection from $remoteAddr $remotePort";
puts "Creating child to controll connection";

set childId [open "|bin/tclsh83 [info script]
newClient $socket" w+]
fileevent $childId readable [list
resiveMessageFromChild $childId];
}
vwait forever;

}

if {$proccessType == "newClient"} {
proc initSocketsEvents {socket} {

# How this proccess can access to channel $socket?
# I need help
#

puts "Child: configure socket [set socket]"
fconfigure $socket -blocking 1 -buffering line
fileevent $socket readable [list proccessConnection
$socket]

#same code to work with sockets
#..
#..
#..
}

proc proccessConnection {socket}
puts "Reading from client socket..."
catch {set state [gets $socket line]} err
if {$err != ""} {
// close socket
catch {close $socket} err
puts "Socket [set socket] closed: connection error";
exit;
}
puts "Got line from socket: [set line]";
}

initSocketsEvents [lindex $argv 1];

vwait forever

}

Second question:
If I am not block sockets, show correctly work with sockets (server/
client) to decrease resource (CPU) usage?

One problem I see is that you are creating child process's using the
open command and passing the socket id on the command line. To the
child the socket id means nothing because no sockets have been opened
by the child. The open command is basically a fork and exec so any
file descriptors that are inherited by the child from the parent are
wiped out by the exec. You need to use the fork command to preserve
open file descriptors between parent and child then the socket id on
the command line will mean something. The TclX extension provides a
fork() command.. Also once you have forked the child you really do not
need to pass anything on the command line since the socket has been
inherited by the child from the parent. Here is a working example. I
spent
way too much time on it since I could not get it to work on a threaded
tcl
interpreter. Unfortunately all of Activestate interps are threaded.
This is a
real big bug and i will report it. I also put a lot of signal
handling;
which digresses from the issue but I figure
you would need it. Just downlod and compile the tclsh interp
without specifying --with-threads on the ./configure line. And of
course
get the Tclx extension and compile. the other packages are from tcllib
If you set nofork to 1 then the parent handles all connections just
by
redefining the request_handler. . Be sure to change the location
of the tclsh to match your location in the script below.
usage type <your filename> -h for usage.
run like so:
<scriptname> -p 3456 -vv -l /tmp/<scriptname.>log
in another terminal run tail -f on /tmp/<scriptname>.log
to see the logging by children and parent process.
in another terminal telnet to the parent:
telnet 127.0.0.1 3456

you will get the usual telnet stuff then start typing
every time you hit enter the child that was spawned to
handle your request will echo what you type back to
you. Close the connection and check the log
the parent should get a SIGCHLD from child and
will delete it from the active list.

Hope this gets you on the way.

Carl

-------------------------Script -------------------------------
#!/bin/sh
# the next line restarts using wish \
exec /opt/usr2/bin/tclsh8.5 "$0" ${1+"$@"}
if { [ catch {package require Tclx } err ] != 0 } {
puts stderr "Unable to find package Tclx ... adjust your
auto_path!";
exit 1;
}
if { [ catch {package require cmdline } err ] != 0 } {
puts stderr "Unable to find package cmdline ... adjust your
auto_path!";
exit 1;
}
if { [ catch {package require log } err ] != 0 } {
puts stderr "Unable to find package log ... adjust your
auto_path!";
exit 1;
}
global usage options pid id params logfd
global forever
set id "SERVER"
set pid [pid]
set childpids {}
set nofork 0
signal trap { SIGUSR1} [list sigUser1 %S ]
signal trap { SIGCHLD} [list sigchild %S ]
signal trap { SIGTERM} [list sigterm %S ]
signal trap { SIGINT} [list sigterm %S ]
proc sigUser1 { signal } {
log::log notice "got signal $signal"
# re-read config
}
proc sigchild { signal } {
global childpids id
log::log notice "got signal $signal"
foreach { cpid signal exitcode } [wait -nohang ] { break; }
log::log info "Child with pid $cpid Exited with code $exitcode"
set idx [lsearch $childpids $cpid ]
if { $idx != -1 } {
set childpids [ lreplace $idx $idx $childpids ]
} else {
log::log error "Child $cpid was unregistered"
}
}
proc sigterm {signal } {
global childpids id forever
# kill all children
if { [string equal $id "SERVER"] } {
log::log notice "Sending termination signals to all children"
kill $childpids
} else {
log::log notice "Exiting on sigterm !"
}
incr forever
}

proc myEcho { chan } {
global forever
set buffer ""
set line ""
cmdtrace on
log::log info "$chan has activity"
while {![eof $chan ] } {
if { [gets $chan line] > 0 } {
append buffer "$line\n"
} else {
break;
}
}
if { ![eof $chan ] } {
log::log info "read in [string length $buffer] bytes"
log::log info "$buffer"
log::log info "Writing buffer back to client"
puts $chan $buffer
flush $chan
} else {
log::log info "Closing channel to client"
catch {close $chan }
incr forever; # tell child to exit
}
}
proc handle_request { chan clientaddr clientport } {
global id pid childpids logfd params
# We want whole lines
#
if { [llength $childpids ] >= $params(m) } {
log::log error "Unable to handle connection too many children"
return;
}
set cpid [fork ]
if { $cpid == 0 } {
# child
set id CHILD
set pid [pid]
close stdin
flush stderr; close stderr
#flush stdout; close stdout
fconfigure $chan -blocking 0 -buffering line
fileevent $chan readable [list myEcho $chan ]
} else {
# parent code
catch { close $chan } err
log::log info " Closing connection to client : $err"
if { $cpid == -1 } {
log::log error "Unable to spawn children"
}
log::log info "Parent spawnd child with pid $cpid"
lappend childpids $cpid
log::log info "Parent has [llength $childpids] active children ]"
}
}
if { $nofork } {
proc handle_request { chan clientaddr clientport } {
fconfigure $chan -blocking 0 -buffering line
fileevent $chan readable [list myEcho $chan ]
}
}
set options {
{ p.arg "8888" "Port for server to listen on" }
{ m.arg "10" "Child limit " }
{ l.arg "stdout" "path to log file for logging" }
{ v "verbose" }
{ vv "double verbose" }
{ vvv "debug level verboseness" }
}

set usage ": $argv0 \[options\] ...\noptions:"
if { [ catch {::cmdline::getoptions argv $options $usage } result ] !=
0 } {
puts "$result"
exit 1
} else {
array set params $result
}
foreach level [ log::levels ] {
log::lvSuppress $level 1
}
if { $params(v) } {
foreach level { notice warning error } {
log::lvSuppress $level 0
}
} elseif { $params(vv) } {
foreach level { notice info warning error } {
log::lvSuppress $level 0
}
} elseif { $params(vvv) } {
foreach level { notice info debug warning error } {
log::lvSuppress $level 0
}
} else {
foreach level { warning error } {
log::lvSuppress $level 0
}
}
proc logproc { level message } {
global id pid
log::Puts $level "\[$id|$pid\][clock format [clock seconds] -
format "%D %T"] - $message"
catch { flush [log::lv2channel $level ] }
}
log::lvCmdForall logproc
if { [string equal $params(l) "stdout"] ||[string equal $params(l)
"stderr"] } {
log::lvChannelForall $params(l)
set logfd $params(l)
} else {
if { [ catch { open $params(l) "a" } err ] != 0 } {
log::lvChannelForall stdout
log::log error "Unable to open $params(l) using stdout for logging."
log::log error "Error was : $err"
set logfd stdout
} else {
log::lvChannelForall $err
set logfd $err
}
}
set logfd [log::lv2channel error ]
# adjust your cmd flags and args here
if { ![string is digit $params(p)] } {
log::log error "Sorry port was not a digit";
exit 1;
} elseif { $params(p) > 65736 } {
log::log error "Port specified was greater than 65736 limit"
exit 1;
} elseif { $params(p) <= 1024 && [id userid] != 0 } {
log::log error "You must be root to run with a port <= 1024"
exit 1;
}

socket -server handle_request $params(p)
log::log notice "listening on port $params(p)"
vwait ::forever
if { [string equal $id "CHILD" ] } {
log::log notice "Client shutdown from lost connection"
}


.

Relevant Pages

  • Re: multithreaded dialog application
    ... multiple threads, a rewrite of the piece of crap in the MSDN. ... the socket messages are posted to the main thread to be processed. ... Nearly all the socket messages are simply passed on to a child dialog ... If you have only one network interface then there ...
    (microsoft.public.vc.mfc)
  • Re: Help with sockets in block mode, please
    ... open command and passing the socket id on the command line. ... child the socket id means nothing because no sockets have been opened ... proc accept { ...
    (comp.lang.tcl)
  • TCP Server+perl
    ... Client each time a new connection is established at the Socket. ... each child completes processing it closes/ends. ... # Main loop control variable ... You exit the ...
    (comp.lang.perl.misc)
  • Re: When [exit] wont exit
    ... the child now does not talk to the parent at all. ... I thought maybe you meant for the parent to pass the child the socket over the pipe or some such. ...
    (comp.lang.tcl)
  • Porting Unix sockets code: socket connection to a child
    ... I'm porting a Unix app which creates a child process, ... to the new process via a socket [this is a client/server application, ... the client talks to the child via a socket]. ...
    (microsoft.public.win32.programmer.kernel)