Handling spawn thru thread in tcl - multithreading

I am trying to handle spawn process thru thread , but its throwing error "invalid command" .
But without thread its working fine .
set listner [thread::create {
package require Expect
proc router_config {s filename} {
set command_router "{Password: } {abc#123\r}
{Router>} {en\r}
{Password: } {abc#123\r}"
spawn telnet 1.1.1.1
foreach {exp_prompt send_cmd} $command_router {
expect "$exp_prompt"
exp_send "$send_cmd"
}
return 1
}
[thread::wait]
}]
set commandString "xyz"
eval [subst {thread::send -async $listner \
{router_config 0 [list $commandString ]}}]
puts "--------->> releasing thread [thread::id] [thread::release]"
exit 0
Please suggest some way to handle .

Related

How to suppress errors/outputs from a TCL thread?

I have created a thread :
set t1 [thread::create]
thread::send $t1 {
proc myProc {command args} {
exec {*}[auto_execok $command] {*}$args >& /dev/null
}
}
And then tried to send an asynchronous command :
thread::send -async $t1 [list myProc <command args>]
But the error/output from the command is getting displayed in output.
How to hide the errors/outputs from the command that is send to the async thread ?
The simplest method is to catch the errors.
thread::send $t1 {
proc myProc {command args} {
catch {
exec {*}[auto_execok $command] {*}$args >& /dev/null
}
}
}
Be aware that this makes any problems significantly more difficult to debug! It's better if you can identify what errors you expect and just try to catch them, so unexpected errors are still things you see and have to handle.
thread::send $t1 {
proc myProc {command args} {
try {
exec {*}[auto_execok $command] {*}$args >& /dev/null
} trap CHILDSTATUS {} {
# Ignore a non-zero exit?
}
}
}
For this specific case (which is very much I/O-bound from Tcl's perspective) you might be better off just adding & to the end of the exec call and not running in a separate thread. Can't really say for sure without knowing exactly what you're doing, but it is worth considering.

expect error handling - spawn id not open

I'm writing an expect script which can log out in hundreds of routers and change their config.
My problem is, there is a bug on the routers firmware which causes them to close the connection after the password is send.
If I log in again, it works perfectly (so only the first log in after reboot causes the exception).
When the connection is closed the expect script is terminated.
I would like if i could gracefully catch the exception, and try again.
The code which fails is this part:
# go through each IP
for {set i $start} {$i <= $end} {incr i} {
set ip "10.$octet2.$i.x"
puts "\n\n\n#### doing $ip...\n" ; flush stdout
# log in to the IP
spawn ssh -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null -l $user $ip
expect {
"continue connecting (yes/no)?" { send "yes\r" ; exp_continue }
"login as: " { send "$user\r" ; exp_continue }
"Password: " { send "$pwd\r" }
"No route to host" { continue }
timeout { continue }
}
# execute commands from file
foreach c "$commands" { eval $c }
}
The error I get looks like this:
Password:
Connection to 10.x.x.x closed by remote host.
Connection to 10.x.x.x closed.
send: spawn id exp11 not open
while executing
"send "exit\r""
("eval" body line 1)
invoked from within
"eval $c "
("foreach" body line 1)
invoked from within
"foreach c "$commands" { eval $c }"
("for" body line 18)
invoked from within
"for {set i $start} {$i <= $end} {incr i} {
set ip "10.$octet2.$i.x"
puts "\n\n\n#### doing $ip...\n" ; flush stdout
# log in to the IP
spa..."
(file "./multido.exp" line 39)
Any help is really appreciated!
You can catch the exception using the tcl command catch to surround the command that might error. You would extend your code's inner loop to resemble this:
set tryrun 1
while {$tryrun} {
spawn ssh ...
expect ...
set tryrun 0
foreach c "$commands" {
if {[catch {eval $c} result]} {
puts "failed: $result"
set tryrun 1
}
}
}
Perhaps a simpler solution would be to look for the pattern "closed by remote host" in your expect, and using this to repeat a similar loop.

tcl thread::send -async not works

I want to send message to thread in synchronous mode and get result using trace variable metohd. The problem is that I dont get any response from thread. When I send message in normal mode (thread:: send thread_id {command} var) then I also get the result which is saved in var. Could anyone point out where I make mistake ? Below I pass my code :
trace add variable res write {apply {{v1 v2 op} {
upvar 1 $v1 v
puts "updated variable to $v"}}}
set th [thread::create {
puts "new thread id : [thread::id]"
proc fun {n} {
return [expr {$n*2}]
}
thread::wait
}]
# thread::send $th [list fun $t] res
thread::send -async $th [list fun 43] res
Are you waiting for events in the source/main thread? If you aren't, you'll never process the asynchronous response message that causes the res variable to be set.

Zombie telnet process pile up while using spawn with Expect

I intend to make a telnet connection with a network device using Expect, and it involves sending commands to the device multiple times and also rebooting the device as well. I thereby need to make the telnet connection again and again.
proc dputs {msg} {
if {[info exists ::debug] && $::debug} {
puts $msg
}
}
proc open_telnet_session {} {
set sResult FAIL
set prompt "(\r|\n|\r\n).*?(#|%|>|\\\$) $"
#set prompt "#|%|>|\\\$ $"
set timeout 60
if {$::tcl_platform(platform) eq "windows"} {
spawn {c:\Dinesh\telnet_32bit.exe} $::device_ip
} else {
spawn telnet $::device_ip
}
set ::device_ip $spawn_id
expect {
timeout {puts "Timeout happened while spawning telnet session";return $sResult}
eof {puts "EOF happened while spawning telnet session";return $sResult}
"login: $" {send "$::device_uname\r";exp_continue}
"password: $" {send "$::device_pwd\r";exp_continue}
-re $prompt
}
set sResult PASS
return $sResult
}
proc send_cmd_to_device {cmd} {
set timeout 180
dputs "cmd : $cmd"
set sResult FAIL
set prompt "(\r|\n|\r\n).*?(#|%|>|\\\$) $"
set ::spawn_id $::device_ip
if {[catch {send "$cmd\r"} errorMsg]} {
puts "Failed to send the commands..."
puts "Reason : $errorMsg"
return $sResult
}
expect {
timeout {puts "Timeout happened while sending commands to telnet session";return 0}
eof {puts "EOF happened while sending commands to telnet session";return 1}
"invalid token" {puts "Invalid token error from device";exp_continue}
"$cmd" { dputs "\n\n matching the cmd\n\n";set ::actual_cmd_match 1;exp_continue}
-re $prompt {
if {$::actual_cmd_match} {
dputs "\n\n final prompt match \n\n"
set ::actual_cmd_match 0
set sResult PASS
} else {
dputs "\n\n still waiting for prompt match \n\n"
exp_continue
}
}
}
return $sResult
}
proc close_telnet_session {} {
set sResult FAIL
set ::spawn_id $::device_ip
#This will send 'Ctrl+]' to close the telnet connection gracefully
if {[catch {send "\x1d"} errorMsg]} {
puts "Failed to send the commands..."
puts "Reason : $errorMsg"
return $sResult
}
expect {
timeout {return $sResult}
eof {return $sResult}
-nocase "telnet>"
}
if {[catch {send "quit\r"}]} {
puts "Failed to send the commands..."
puts "Reason : $errorMsg"
return $sResult
}
expect {
timeout {return $sResult}
eof {set sResult PASS}
}
return $sResult
}
Even though I am closing the connection gracefully, I can still see the process running in the task manager (in Windows 7). (Same case with Linux as well, telnet process shows up as <defunct> process).
If I run the script overnight and say I have to open the telnet connection about thousands of time (as my script involves rebooting the device multiple times and thus the management connection will be lost), it will end up reducing the performance.
This will lead to memory leak or failure in resource allocation when this happens continuously.
After searching a lot, I end up with exp_close and exp_wait.
# Killing the process in Windows...
exec taskkill /pid $telnet_process_id
exp_close -i $::device_id
exp_wait -i $::device_id; # This becomes a blocking call..
With the above code, exp_wait is keep on waiting and it is getting blocked in there.
To avoid the same, I have used -nowait flag as well, but still no use. It is returning immediately and the process still stays in the process chart.
What should be the optimal way to handle this issue?
In my experience, spawned process connections are usually terminated with a call to close. Is expect on windows different than expect on *nix in that regard?

How can I send messages (or signals) from a parent process to a child process and viceversa in Perl?

Im writing a program that manage muti-processes. This is what I have done and its working great! but now, I want to send messages from the child processes to the parent process and viceversa (from the parent to the childs), do you know the best way? Do you know if what I have done is the proper way for what I want (send messages, or signals or share memory from the child processes to the parent process and viceversa)?
Thanks in advance!!
#!/usr/bin/perl -w
use strict;
use warnings;
main(#ARGV);
sub main{
my $num = 3; #this may change in the future (it would be dynamic)
my #parts = (1,4,9,17,23,31,46,50);
my #childs = ();
while(scalar(#parts)>0 || scalar(#childs)>0){
if(scalar(#parts)>0){
my $start = scalar(#childs) + 1;
for($start..$num){
my $partId = pop(#parts);
my $pid = fork();
if ($pid) {
print "Im going to wait (Im the parent); my child is: $pid. The part Im going to use is: $partId \n";
push(#childs, $pid);
}
elsif ($pid == 0) {
my $slp = 5 * $_;
print "$_ : Im going to execute my code (Im a child) and Im going to wait like $slp seconds. The part Im going to use is: $partId\n";
sleep $slp;
print "$_ : I finished my sleep\n";
exit($slp);
}
else{
die "couldn’t fork: $!\n";
}
}
}
print "before ret\n";
my $ret = wait();
print "after ret. The pid=$ret\n";
my $index = 0;
for my $value (#childs){
if($value == $ret) {
splice #childs, $index, 1;
last;
}
$index++;
}
}
}
Use kill. If you set a variable in the parent before your fork, you don't need any external options.
my $parent_pid = $$; # Keep a reference to the parent
my $pid = fork();
if ($pid) {
print "Im going to wait (Im the parent);
my child is: $pid. The part Im going to use is: $partId \n";
push(#childs, $pid);
}
elsif ($pid == 0) {
my $slp = 5 * $_;
print "$_ : Im going to execute my code (Im a child) and Im going to wait like $slp seconds. The part Im going to use is: $partId\n";
sleep $slp;
print "$_ : I finished my sleep\n";
kill 20, $parent_pid # Send a signal to the parent, 20 is SIGCHLD
exit($slp);
}
See perldoc -f kill for more details on the kill call
Another option if you need to do more complex things is to use POE
Forks::Super has a good interface for passing messages between parent and child processes (interprocess communication). With this interface, you can pass messages to the child's STDIN and read from the child's STDOUT and STDERR handles.
use Forks::Super;
# set up channels to child's STDIN/STDOUT/STDERR with blocking I/O
my $pid = fork { child_fh => 'all,block' };
if ($pid) { # parent
$pid->write_stdin("Hello world\n");
my $msg_from_child = $pid->read_stdout(); # <-- "HELLO WORLD\n"
print "Message from child to parent: $msg_from_child";
}
elsif (defined($pid) && $pid == 0) { # child
sleep 1;
my $msg_from_parent = <STDIN>; # <-- "Hello world\n"
my $output = uc $msg_from_parent;
print $output;
exit 0;
}
else{
die "couldn’t fork: $!\n";
}

Resources