Perl: stop a command started using perl "system" in windows - windows

in Perl, I started two commands in two different windows command line (Cmd) , as follow:
system("start $cmd1");
system("start $cmd2");
Basically, both commands continue running until I stop them using "CTRL+C".
My question is :
How to send "CTR+C" to each Cmd line (or command) ?
Thank you.

I think you can use
my $pid = system(1, $cmd1);
# One of the following:
kill(INT => $pid); # Sends Ctrl-C
kill(TERM => $pid); # Sends Ctrl-Break
kill(KILL => $pid); # Calls TerminateProcess($handle, 9)
waitpid($pid, 0);

I solved it by creating two detached processes. See the code below: `
use Win32::Process;
use Win32;
sub ErrorReport{
print Win32::FormatMessage( Win32::GetLastError() );
}
Win32::Process::Create($ProcessObj,
"C:\\winnt\\system32\\notepad.exe",
"notepad temp.txt",
0,
DETACHED_PROCESS,
".")|| die ErrorReport();
$ProcessObj->Suspend();
$ProcessObj->Resume();
$ProcessObj->Wait(INFINITE);
`

Related

Perl Windows alternatives for "system" ( opening multiple processes )

So long story short, I'm trying to run a linux perl script in Windows ( with few modifications ).
On Unix it works just fine, but on Windows I come to the conclusion that calling for system doesn't work the same as on Unix and so it doesn't create multiple processes.
Below is the code :
use strict;
use warnings;
open (FIN, 'words.txt'); while (<FIN>) {
chomp;
my $line = $_;
system( "perl script.pl $line &" );
}
close (FIN);
So basically, I have 5 different words in "words.txt" which I want each and every one to be used one by one when calling for script.pl , which means :
word1 script.pl
word2 script.pl
word3 script.pl
etc
As of now it opens just the first word in words.txt and it loops with that one only. As I said, on Unix it works perfectly, but not on Windows.
I've tried to use "start" system( "start perl script.pl $line &" ); and it works...except it opens 5 additional CMDs to do the work. I want it to do the work on the same window.
If anyone has any idea how this can work on window, i'll really appreciate it.
Thanks!
According to perlport :
system
(Win32) [...] system(1, #args) spawns an external process and
immediately returns its process designator, without waiting for it to
terminate. Return value may be used subsequently in wait or waitpid.
Failure to spawn() a subprocess is indicated by setting $? to 255 <<
8. $? is set in a way compatible with Unix (i.e. the exit status of the subprocess is obtained by $? >> 8, as described in the
documentation).
I tried this:
use strict;
use warnings;
use feature qw(say);
say "Starting..";
my #pids;
for my $word (qw(word1 word2 word3 word3 word5)) {
my $pid = system(1, "perl script.pl $word" );
if ($? == -1) {
say "failed to execute: $!";
}
push #pids, $pid;
}
#wait for all children to finish
for my $pid (#pids) {
say "Waiting for child $pid ..";
my $ret = waitpid $pid, 0;
if ($ret == -1) {
say " No such child $pid";
}
if ($? & 127) {
printf " child $pid died with signal %d\n", $? & 127;
}
else {
printf " child $pid exited with value %d\n", $? >> 8;
}
}
say "Done.";
With the following child script script.pl :
use strict;
use warnings;
use feature qw(say);
say "Starting: $$";
sleep 2+int(rand 5);
say "Done: $$";
sleep 1;
exit int(rand 10);
I get the following output:
Starting..
Waiting for child 7480 ..
Starting: 9720
Starting: 10720
Starting: 9272
Starting: 13608
Starting: 13024
Done: 13608
Done: 10720
Done: 9272
Done: 9720
Done: 13024
child 7480 exited with value 9
Waiting for child 13344 ..
child 13344 exited with value 5
Waiting for child 17396 ..
child 17396 exited with value 3
Waiting for child 17036 ..
child 17036 exited with value 6
Waiting for child 17532 ..
child 17532 exited with value 8
Done.
Seems to work fine..
You can use Win32::Process to get finer control over creating a new process than system gives you on Windows. In particular, the following doesn't create a new console for each process like using system("start ...") does:
#!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;
# Older versions don't work with an undef appname argument.
# Use the full path to perl.exe on them if you can't upgrade
use Win32::Process 0.17;
my #lines = qw/foo bar baz quux/; # For example instead of using a file
my #procs;
for my $line (#lines) {
my $proc;
if (!Win32::Process::Create($proc, undef, "perl script.pl $line", 1,
NORMAL_PRIORITY_CLASS, ".")) {
$_->Kill(1) for #procs;
die "Unable to create process: $!\n";
}
push #procs, $proc;
}
$_->Wait(INFINITE) for #procs;
# Or
# use Win32::IPC qw/wait_all/;
# wait_all(#procs);
As Yet Another Way To Do It, the start command takes a /b option to not open a new command prompt.
system("start /b perl script.pl $line");

How to do parallel programming in perl on Windows?

I have used the following pattern of code in perl on a Unix system, but it crashes on Windows. How can I achieve the same thing using either forking or threads on Windows using perl?
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new($MAX_PROCESSES);
DATA_LOOP:
foreach my $data (#all_data) {
# Forks and returns the pid for the child:
my $pid = $pm->start and next DATA_LOOP;
# ... do some work with $data in the child process ...
$pm->finish; # Terminates the child process
}
Here is one example using fork:
#!/usr/bin/perl -w
use strict;
foreach my $data (#all_data) {
my $pid;
next if $pid = fork; # Parent goes to next server.
die "fork failed: $!" unless defined $pid;
# From here on, we're in the child. Do whatever the
# child has to do... The server we want to deal
# with is in $data.
exit; # Ends the child process.
}
# The following waits until all child processes have
# finished, before allowing the parent to die.
1 while (wait() != -1);
print "All done!\n";

Not able to connect to socket using socat

I am trying to parse rsyslog logs. For this i am sending all my logs to socat which is then sending them to Unix Domain Socket. That socket is created via perl script which is listening on that socket to parse logs.
My bash script to which rsyslog is sending all log is
if [ ! `pidof -x log_parser.pl` ]
then
./log_parser.pl & 1>&1
fi
if [ -S /tmp/sock ]
then
/usr/bin/socat -t0 -T0 - UNIX-CONNECT:/tmp/sock 2>> /var/log/socat.log
fi
/tmp/sock is created using perl script log_parser.pl which is
use IO::Socket::UNIX;
sub socket_create {
$socket_path = '/tmp/sock';
unlink($socket_path);
$listner = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Local => $socket_path,
Listen => SOMAXCONN,
Blocking => 0,
)
or die("Can't create server socket: $!\n");
$socket = $listner->accept()
or die("Can't accept connection: $!\n");
}
socket_create();
while(1) {
chomp($line=<$socket>);
print "$line\n";
}
There is this error i am getting from socat which is
2015/02/24 11:58:01 socat[4608] E connect(3, AF=1 "/tmp/sock", 11): Connection refused
I am no champion in sockets so i am not able to understand what is this. Please help. Thanks in advance.
The main issue is that when i kill my perl script then bash script is suppose to call it again and start it.
What actually happening is that sript is started but socat is not started instead it give this error and never start.
I can duplicate your error if I don't run your perl program before trying to use socat. Here is what works for me:
1) my_prog.pl:
use strict;
use warnings;
use 5.016;
use Data::Dumper;
use IO::Socket::UNIX;
my $socket_path = '/tmp/sock';
unlink $socket_path;
my $socket = IO::Socket::UNIX->new(
Local => $socket_path,
Type => SOCK_STREAM,
Listen => SOMAXCONN,
) or die "Couldn't create socket: $!";
say "Connected to $socket_path...";
my $CONN = $socket->accept()
or die "Whoops! Failed to open a connection: $!";
{
local $/ = undef; #local -> restore previous value when the enclosing scope, delimited by the braces, is exited.
#Setting $/ to undef puts file reads in 'slurp mode' => whole file is considered one line.
my $file = <$CONN>; #Read one line.
print $file;
}`
2) $ perl my_prog.pl
3) socat -u -v GOPEN:./data.txt UNIX-CONNECT:/tmp/sock
The -u and -v options aren't necessary:
-u Uses unidirectional mode. The first address is only used for
reading, and the second address is only used for writing (exam-
ple).
-v Writes the transferred data not only to their target streams,
but also to stderr. The output format is text with some conver-
sions for readability, and prefixed with "> " or "< " indicating
flow directions.
4) You can also do it like this:
cat data.txt | socat STDIN UNIX-CONNECT:/tmp/sock
Pipe stdout of cat command to socat, then list STDIN as one of socat's files.
Response to comment:
This bash script works for me:
#!/usr/bin/env bash
echo 'bash script'
../pperl_programs/my_prog.pl &
sleep 1s
socat GOPEN:./data.txt UNIX-CONNECT:/tmp/sock
It looks like the perl script doesn't have enough time to setup the socket before socat tries to transfer data.

mulitple parameters in perl system function for windows

I have one scneario where i have to execute one java program & for that i have to first set the class path & all those being invoked under single perl program. I am trying below command which doesn't work:
$command1="echo \" First command\"";
$command2="echo \" Second command\"";
system("$command1;$command2");
Above command works fine in LINUX but not in windows. Please help me in execution of this.
On most platforms,
system($shell_command);
means
system('sh', '-c', $shell_command);
On Windows, it means something closer to
system('cmd', '/x', '/c', $shell_command);
Option 1
Keep using a bourne shell command, but explicitly specify a bourne shell is needed.
system('sh', '-c', 'echo 1 ; echo 2');
This isn't likely to work since the computer is not likely to have a bourne shell installed.
Option 2
Use the correct syntax for the local shell.
if ($O eq 'MSWin32') {
system('echo 1 & echo 2');
} else {
system('echo 1 ; echo 2');
}
Option 3
Call system twice.
system('echo 1');
system('echo 2');
If you want to use ; between commands you have to invoke shell. This is alternative to ;
my #cmds =(
[ "echo", q{" First command"} ],
[ "echo", q{" Second command"} ],
);
system (#$_) for #cmds;
Is this what you are trying
$a=" echo wasssup people";
$b=" echo hi guys";
system("$a"."$b");

Hiding User Input

I'm trying to get a script that works both in a native windows shell and a cygwin shell (via ssh) that prompts for and reads a password entered by the user. So far, I have tried the following methods:
using Term::ReadKey and setting ReadMode to 'noecho'
RESULT: returns an error GetConsoleMode failed and quits
using Term::ReadPassword::Win32
RESULT: hangs and never offers a prompt or reads input
using IO::Prompt
RESULT: returns an error Cannot write to terminal and quits
using Term::InKey
RESULT: returns an error Not implemented on MSWin32: The handle is invalid and quits
All of these work in a native Windows shell (command prompt or power shell), but none of them work when I'm in an ssh session to the server.
Really, that's what I'm most interested in, getting it to work in the remote ssh session.
I'm getting ssh via cygwin installed on the Windows server (2003 R2). I'm using strawberry perl and not the cygwin perl (cygwin perl breaks other perl scripts I need to run natively in Windows, not via ssh).
My best guess is that cygwin+Windows is screwing with strawberry perl enough that it can't tell what kind of environment it is in. I'm looking into alternative sshd+Windows solutions to explore this.
These are all the methods I've been able to find in my searching. Does anybody else have any other methods for hiding user input they can suggest?
use Term::ReadKey;
print "Please enter your artifactory user name:";
$username = <STDIN>;
chomp($username);
ReadMode('noecho'); # don't echo
print "Please enter your artifactory password:";
$password = <STDIN>;
chomp($password);
ReadMode(0); #back to normal
print "\n\n";
I would try outputting the environment variables (%ENV) during the sessions that work, and then again during the sessions that don't. I find that, when dealing with terminal IO, you have to carefully tweak the "TERM" variable based on things like the $^O variable and $ENV{SESSIONNAME} (in Windows).
how about Term::ReadKey's ReadMode(4)? i've just used this in a personal project, having found the answer here
works on cygwin / win7, can't vouch for native windows shell however.
use strict;
use warnings;
use Term::ReadKey;
sub get_input {
my $key = 0;
my $user_input = "";
# disable control keys and start reading keys until enter key is pressed (ascii 10)
ReadMode(4);
while (ord($key = ReadKey(0)) != 10)
{
if (ord($key) == 127 || ord($key) == 8) {
# backspace / del was pressed. remove last char and move cursor back one space.
chop ($user_input);
print "\b \b";
} elsif (ord($key) < 32) {
# control characters, do nothing
} else {
$user_input = $user_input . $key;
print "*";
}
}
ReadMode(0);
return $user_input;
}
# variables
my $password = "";
my $username = "";
print "\nPlease input your username: ";
$username = get_input();
print "\nHi, $username\n";
print "\nPlease input your password: ";
$password = get_input();

Resources