Axel Mock <> wrote:
> Hi,
>
> as announced yesterday here is my way of executing remotely commands
> on a Windows machine:
>
> - Win32ForkServer.pl
> - Win32Client.pl
>
>
> #----------------------------------------------------------
> # Name : Win32ForkServer.pl
> # Author : Axel Mock
> #
> # Description:
> # PERL script implementing the socket server for the RCMD service #
> on Windows Remote Target Compile machines allowing commands to be #
> executed on that machine from a remote client. # Specialty: DOES
> FORKING using Win32 PERL Pseudo-Fork (PERL
> threads)
Oh no! Somebody else who can't spell.
(Hint: see 'perldoc -q "Perl.*and.*perl"')
> # one time directly using fork and another time indirectly using
> IO:PIPE # for capturing the output. #
> # Should be installed on the target as a service using
> # srvany.exe and instsrv.exe from the Windows Resource Kit
> #
> #
> #
> #----------------------------------------------------------
The following two lines seem to be missing:
use strict;
use warnings;
>
> use IO::Socket;
> use IO::Pipe;
> use IO::Select;
> use POSIX 'WNOHANG';
> use Net::hostent;
>
> use constant PORT => 2222;
> my $DEBUG;
>
> sub TimeStamp {
> my (@t) = localtime (time());
> #$dt becomes DDMMYYhhmmss
> return (sprintf ("%02d-%02d-%04d %02d:%02d:%02d", $t[3],$t[4]+1,
> $t[5]+1900, $t[2],$t[1], $t[0]));
>
> }
>
> sub interact {
> my ($sock) = shift;
>
> # part of child process
> $sock->autoflush (1);
>
> while (defined ($request = <$sock>)) {
> # do something with $buf ....
> if ($request =~ /exec:(.+)/ ) {
> $request = $1;
> print STDERR "\t\t\tRequest: $request\n" if $DEBUG;
> my ($pipe) = new IO::Pipe;
> $pipe->reader ("$request 2>&1");
Is there any advantage to using IO::Pipe rather than open $pipe,
"$request 2>&1 |" ??
>
> while ($line = <$pipe>) {
> print $sock $line;
> }
> $answer = "\n\n$request .. handled\n";
> print $sock $answer;
> }
> else {
> print $sock "\n\nUnknown request: $request
..handled\n" if
> $DEBUG; }
> }
>
> return (0);
> }
>
> sub ReapChildren {
> while ( waitpid (-1, WNOHANG) > 0) {} ; }
>
>
> # ---------- M A I N ------------
>
> if (scalar (@ARGV) > 0) {
> $DEBUG = grep (/^-D\s*(\d*)?$/i, @ARGV); }
>
>
> # Signal handler for CHILD process
> $SIG{CHLD} = sub { ReapChildren () };
I was under the impression that, apart from a couple of hacks for
SIG_ALRM and SIG_INT, signals don't work on Win32.
>
> $listen_socket = new IO::Socket::INET (LocalPort => PORT,
> Listen => 20,
> Proto => 'tcp',
> Reuse => 1,
>
Timeout
> => 60*60,
An hour? That seems quite long.
> );
> unless ($listen_socket) {
> die "Listening socket could not be created. Reason: [EMAIL PROTECTED]";
> }
>
> $listen_socket->blocking (0); # make the socket non-blocking
> my $listener = IO::Select->new ($listen_socket);
>
>
> warn ("Server started, Listening on port " . PORT. "\n") if $DEBUG;
>
> while (1) {
> my $ready = $listener->can_read;
> if ($ready) {
> next unless (my $client = $listen_socket->accept());
> $client->blocking (1);
> ReapChildren ();
> # print STDERR "Connect \n";
>
> defined (my $child = fork ()) || (die "Cannot fork:
$!");
>
> if ($child == 0) {
> $listen_socket->close;
>
> my $hostinfo = gethostbyaddr($client->peeraddr);
> my $hostname = $hostinfo->name || $client-
>> peerhost;
> $msg = sprintf "[%s # Connect from %s (%s:%4d)
]\n", TimeStamp
> (), $hostname, $client->peerhost,
$client->peerport; print STDERR
> $msg if $DEBUG;
>
> my $result = interact ($client);
>
> $msg = sprintf "[%s # Closing %s:%4d ]\n",
TimeStamp (),
> $client->peerhost, $client->peerport; print
STDERR $msg if $DEBUG;
> exit (0);
> }
> # parent process does not need this connection, so close
it
> $client->close ();
> }
> else {
> sleep ();
> }
> }
>
> # main server finishes : close the socket close ($listen_socket);
>
> __END__
>
>
>
>
> #----------------------------------------------------------
> # Name : Win32Client.pl
> # Author : Axel Mock
> #
> # Description:
> # PERL script implementing the socket client for the RCMD service.
> # To be used interactively for testing purposes.
> #
> #
> #----------------------------------------------------------
Again, no use of strictures or warnings.
> use IO::Socket;
>
> my ($request, $answer);
>
> unless (@ARGV > 1) {
> die "usage: $0 host $request ..."
> }
> $host = shift(@ARGV);
> $request = join (' ', @ARGV);
>
> $remote = IO::Socket::INET->new( Proto => "tcp",
>
PeerAddr
> => $host,
>
PeerPort
> => 2222,
> );
> unless ($remote) {
> die "cannot connect to server port 2222 daemon on $host"
> }
> $remote->autoflush(1);
> #setsockopt ($remote, IPPROTO_TCP, TCP_NODELAY, 1);
>
>
> print "requesting : $request\n";
> print $remote "exec: $request\n";
> while (1) {
> if (defined ($answer = <$remote>) ) {
> print $answer;
> if ($answer =~ /\.\.\s*handled/) {
> last ();
> }
> }
> else {
> sleep (1);
> }
> }
> close $remote;
>
> __END__
>
>
> Usage:
>
> Install Win32ForkServer via InstSrv / InstAny on the remote machine.
> Do NOT forget to open the corresponding port in the Windows firewall.
> For test
>
> Run Win32Client on the controlling machine:
>
> perl win32client remotemachine COMMAND
>
> e.g.
> perl win32client 192.168.10.25 dir C:\W*
>
> Please postpone any questions to next week...
>
> Good luck,
> Axel
Apart from that, it seems OK. Apart from the fact that it is very
insecure, of course. Only run in anvironment where that insecurity wont
be a problem, and be careful which user it is run as (e.g. don't run as
a user with administrator priviledges).
Thanks for sharing, Axel.
HTH
--
Brian Raven
=================================
Atos Euronext Market Solutions Disclaimer
=================================
The information contained in this e-mail is confidential and solely for the
intended addressee(s). Unauthorised reproduction, disclosure, modification,
and/or distribution of this email may be unlawful.
If you have received this email in error, please notify the sender immediately
and delete it from your system. The views expressed in this message do not
necessarily reflect those of Atos Euronext Market Solutions.
L'information contenue dans cet e-mail est confidentielle et uniquement
destinee a la (aux) personnes a laquelle (auxquelle(s)) elle est adressee.
Toute copie, publication ou diffusion de cet email est interdite. Si cet e-mail
vous parvient par erreur, nous vous prions de bien vouloir prevenir
l'expediteur immediatement et d'effacer le e-mail et annexes jointes de votre
systeme. Le contenu de ce message electronique ne represente pas necessairement
la position ou le point de vue d'Atos Euronext Market Solutions.
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
