Perl; socket
Hi,
I have made a TCP socket, both a server and a client, and it works just
fine, except from the fact that I cant receive more than one input line from
the server when I execute a Unix command trough the socket. And when I am
trying to send a ps command from the client to the server to count how many
proc a certain user are running, the client does not receive the output,
like the server does.
This problem is a bit hard to explain, so please se my two scripts for more:
*server.pl*
#!/usr/bin/perl
# Needed pkg
use Getopt::Std;
use strict vars;
# Global variables
my $VERBOSE = 0;
my $DEBUG = 0;
# handle flags and
# Example: c == -c, c: == -c argument
my $opt_string = 'hvdk:p:';
getopts( $opt_string, \my %opt ) or usage() and exit 1; # exit other than
0 = error!!
# print help message if -h is invoked
if ( $opt{'h'} ){
usage();
exit 0;
}
$VERBOSE = 1 if $opt{'v'};
$DEBUG = 1 if $opt{'d'};
my $PORT = $opt{'p'};
if ( not $PORT ) {
print You need to apply a port number;
usage();
exit 1;
}
# main program content
use IO::Socket;
$SIG{CHILD} = IGNORE; # Enable us to not make the children hangout and
wait for the parent to die, (children will die)
my $sock = new IO::Socket::INET(
LocalPort = $PORT,
Proto = 'tcp',
Listen = SOMAXCONN,
Reuse = 1
);
if ( $sock ) {
print Waiting for clients...\n;
while ( my $connection = $sock-accept() ){
my $pid = fork(); # how the server knows if the porc is parent (pid =
xxx) or child (0)
if ( $pid == 0 ) {
my $client = $connection-peerhost(); # use $connection instead of
$sock to get ipaddr
print Connection to the $client\n;
my $buffer = $connection;
chomp $buffer;
print Client said: '$buffer'\n;
# sleep 7;
print $connection Message recived: $buffer\n;
close($connection);
exit; # server child should die after finish the conversation
} else {
close($connection);
next;
}
}
} else {
die Error: $!\n;
}
close($sock);
verbose(verbose\n);
debug(noe\n);
##
# Helper routines
sub usage {
# print the correct use of this script
print Usage:\n;
print -hUsage\n;
print -vVerbose\n;
print -dDebug\n;
}
sub verbose {
print $_[0] if ( $VERBOSE or $DEBUG );
}
sub debug {
print $_[0] if ( $DEBUG );
}
*client.pl *
#!/usr/bin/perl
# Needed pkg
use Getopt::Std;
use strict vars;
# Global variables
my $VERBOSE = 0;
my $DEBUG = 0;
# handle flags and
# Example: c == -c, c: == -c argument
my $opt_string = 'hvdk:p:H:c:';
getopts( $opt_string, \my %opt ) or usage() and exit 1; # exit other than
0 = error!!
# print help message if -h is invoked
if ( $opt{'h'} ){
usage();
exit 0;
}
$VERBOSE = 1 if $opt{'v'};
$DEBUG = 1 if $opt{'d'};
my $PORT = $opt{'p'};
my $SERVER = $opt{'H'};
my $COMMAND = $opt{'c'};
if ( not ( $PORT and $SERVER )){
print You need to supply a port number and hostname\n;
usage();
exit 1;
}
# main program content
use IO::Socket;
my $connection = new IO::Socket::INET(
PeerAddr = $SERVER,
PeerPort = $PORT,
Proto = 'tcp'
) or die Failed to connect: $!\n;
if ( $connection ) {
print Connection etablished...\n;
# print $connection hello world!\n;
# print $connection Isabelle says hello\n;
my $load = `uptime | awk '{print \$8 \$9 \$10 \$11
\$12}'`;
my $uptime = `uptime | awk '{print \$2 \$3 \$4}'`;
my $mem_tot = `cat /proc/meminfo | grep MemTotal`;
if ($COMMAND =~ m/load/){
print $connection $load;
}
if ($COMMAND =~ m/uptime/){
print $connection $uptime;
}
if ($COMMAND =~ m/memory/){
print $connection $mem_tot\n;
}
if ($COMMAND =~ m/user:/){
while ($COMMAND){
my @array = split(:, $COMMAND);
my $user = $array[1];
my $ps = `ps aux | grep $user | wc -l`;
print $connection $ps;
sleep 7;
}
}
# $mem_free\n$mem_buff\nswa_tot\n$swa_free\n;
# print $connection `$COMMAND`;
my $response = $connection;
print Server replied: '$response'\n;
close($connection);
}
##
# Helper routines
sub usage {
# print the correct use of this script
print Usage:\n;
print -hUsage\n;
print -vVerbose\n;
print -dDebug\n;
print -pPort\n;
print -HHost/Server\n;
}
sub verbose {
$_[0] if ( $VERBOSE or $DEBUG );
}
sub debug {
print $_[0] if ( $DEBUG );
}
Re: Perl; socket
Nz == Niko zuna niko.z...@gmail.com writes:
Nz #!/usr/bin/perl
Nz # Needed pkg
no need for comments like that.
Nz use Getopt::Std;
use Getopt::Long instead. you can still have short names but also long
names.
Nz use strict vars;
why 'vars'? just plain strict is better.
Nz # Global variables
again, a useless comment. this is like saying $i++ # add 1 to $i
Nz my $VERBOSE = 0;
Nz my $DEBUG = 0;
Nz
Nz # handle flags and
Nz # Example: c == -c, c: == -c argument
Nz my $opt_string = 'hvdk:p:';
Nz getopts( $opt_string, \my %opt ) or usage() and exit 1; # exit other
than
Nz 0 = error!!
be careful how you paste code into email or other places. that word
wrapped and would break if i tried to cut/paste it to run here.
Nz # print help message if -h is invoked
Nz if ( $opt{'h'} ){
Nz usage();
Nz exit 0;
Nz }
Nz $VERBOSE = 1 if $opt{'v'};
Nz $DEBUG = 1 if $opt{'d'};
Nz my $PORT = $opt{'p'};
Nz if ( not $PORT ) {
Nzprint You need to apply a port number;
Nzusage();
Nzexit 1;
Nz }
put all that arg processing into a sub. it makes it easier to manage and
also to read the code. i call it process_options() and put it at the
bottom of the script out of the way.
Nz # main program content
Nz use IO::Socket;
Nz $SIG{CHILD} = IGNORE; # Enable us to not make the children hangout and
Nz wait for the parent to die, (children will die)
Nz my $sock = new IO::Socket::INET(
use direct method calls. this was discussed here very recently.
IO::Socket::INET-new(
Nz LocalPort = $PORT,
Nz Proto = 'tcp',
Nz Listen = SOMAXCONN,
Nz Reuse = 1
Nz );
Nz if ( $sock ) {
Nz print Waiting for clients...\n;
Nz while ( my $connection = $sock-accept() ){
Nz my $pid = fork(); # how the server knows if the porc is parent (pid =
Nz xxx) or child (0)
Nz if ( $pid == 0 ) {
Nz my $client = $connection-peerhost(); # use $connection instead of
Nz $sock to get ipaddr
Nz print Connection to the $client\n;
Nz my $buffer = $connection;
Nz chomp $buffer;
Nz print Client said: '$buffer'\n;
Nz # sleep 7;
Nz print $connection Message recived: $buffer\n;
you only read one line there. if you want to read multiple lines you
need to loop until you detect eof or some end of command line you send
from the client.
Nz close($connection);
Nz exit; # server child should die after finish the conversation
Nz } else {
Nz close($connection);
Nz next;
Nz }
Nz }
Nz } else {
Nz die Error: $!\n;
Nz }
that should be:
$socket or die Error: $!\n;
then the good socket code follows inline with no block. no need for
if/else and blocks and extra indents.
Nz close($sock);
Nz verbose(verbose\n);
Nz debug(noe\n);
Nz ##
Nz # Helper routines
again, useless comments.
put the process_options sub down here. it will be easier to edit these
if they are near each other.
Nz sub usage {
Nz # print the correct use of this script
Nz print Usage:\n;
Nz print -hUsage\n;
Nz print -vVerbose\n;
Nz print -dDebug\n;
Nz }
Nz sub verbose {
Nz print $_[0] if ( $VERBOSE or $DEBUG );
Nz }
Nz sub debug {
Nz print $_[0] if ( $DEBUG );
Nz }
many of the comments above are also for the client code.
Nz my $COMMAND = $opt{'c'};
Nz if ( not ( $PORT and $SERVER )){
Nz print You need to supply a port number and hostname\n;
Nz usage();
Nz exit 1;
Nz }
Nz # main program content
Nz use IO::Socket;
Nz my $connection = new IO::Socket::INET(
Nz PeerAddr = $SERVER,
Nz PeerPort = $PORT,
Nz Proto = 'tcp'
Nz ) or die Failed to connect: $!\n;
Nz if ( $connection ) {
Nz print Connection etablished...\n;
Nz # print $connection hello world!\n;
Nz # print $connection Isabelle says hello\n;
Nz my $load = `uptime | awk '{print \$8 \$9 \$10 \$11
Nz \$12}'`;
Nz my $uptime = `uptime | awk '{print \$2 \$3 \$4}'`;
Nz my $mem_tot = `cat /proc/meminfo | grep MemTotal`;
why execute all the command when only one is needed? this is a waste of
cpu.
Nz if ($COMMAND =~ m/load/){
Nz print $connection $load;
Nz }
those are multiple lines of text. you print them to the socket but the
server only reads one line and closes the connection.
Nz if ($COMMAND =~ m/uptime/){
Nz print $connection $uptime;
Nz }
Nz if ($COMMAND =~ m/memory/){
Nz print $connection $mem_tot\n;
Nz }
Nz if ($COMMAND =~ m/user:/){
use a dispatch table (google for that). then you have a sub for each
command which will execute the command and send the output to the
socket. or
Re: Modules download from CPAN
Hi, CPAN::Mini can be used to create/update local mirrors. minicpan script (http://search.cpan.org/perldoc?minicpan) which uses CPAN::Mini will be helpful in maintaining a local CPAN mirror. Regards, Alan Haggai Alavi. -- The difference makes the difference. -- To unsubscribe, e-mail: beginners-unsubscr...@perl.org For additional commands, e-mail: beginners-h...@perl.org http://learn.perl.org/
Re: Modules download from CPAN
Alan Haggai Alavi wrote: Hi, CPAN::Mini can be used to create/update local mirrors. minicpan script (http://search.cpan.org/perldoc?minicpan) which uses CPAN::Mini will be helpful in maintaining a local CPAN mirror. If you're going to working on CPAN, you should sign up for the CPAN mailing lists: http://lists.perl.org/tag/cpan.html -- Just my 0.0002 million dollars worth, Shawn Programming is as much about organization and communication as it is about coding. I like Perl; it's the only language where you can bless your thingy. Eliminate software piracy: use only FLOSS. -- To unsubscribe, e-mail: beginners-unsubscr...@perl.org For additional commands, e-mail: beginners-h...@perl.org http://learn.perl.org/
Re: Getting a subroutine reference from an object instance
On Fri, 09 Apr 2010 16:34:27 +0200, Eric Veith1 wrote: Peter, I suspect you would have an easier time if you wrote what sounds like a largish project using Moose and composed in a forkable role. If you must use method attributes there is MooseX::MethodAttributes but (and I am getting beyond my experience here) it does not appear popular. Hm, what else would you have prefered? Right now I use a r/o attribute to set up a per-class list of methods that do not fork (actually, more commands *do* fork than not). Method attributes would have eliminated some typos. *grin* You appear to be further along than your original post suggested to me. Well, it's an interesting problem. I've not done much advanced Moose, although I'd like to. You could define a forkable role with before and after hooks to do the forking, but that requires retyping the method names, so I see the appeal of using attributes to label forking methods. Then I wonder about moving all the forkable methods to their own file and using meta to apply the forkability, but I am getting out of my depth. You'd probably benefit from taking this to a Moose list. -- Peter Scott http://www.perlmedic.com/ http://www.perldebugged.com/ http://www.informit.com/store/product.aspx?isbn=0137001274 http://www.oreillyschool.com/courses/perl1/ -- To unsubscribe, e-mail: beginners-unsubscr...@perl.org For additional commands, e-mail: beginners-h...@perl.org http://learn.perl.org/
Feeding ouput from Net::Telnet into sub
I get a page full of output from a command passed into a Net::Telnet session
that as per the cpan example is stored in $output. I then want to call a sub
passing $output into it, that matches a string against each line, and sets a
a var to OK if the match is successful.
All is well, but I am unclear on the correct way to loop through each line in
$output, when I simply print it, it appears over several lines in the terminal.
When I run it into my sub, its being treated as one line?
sub parse_output {
foreach (@_) {
chomp($_);
print Line: $_\n;
if ( $_ =~ /$match/ ) {
$status = OK;
next;
}
}
}
parse_output($output);
It only prints one Line: although it works as it sets $status?
What am I missing?
Thanks!
jlc
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
Re: Feeding ouput from Net::Telnet into sub
JLC == Joseph L Casale jcas...@activenetwerx.com writes:
JLC I get a page full of output from a command passed into a
JLC Net::Telnet session that as per the cpan example is stored in
JLC $output. I then want to call a sub passing $output into it, that
JLC matches a string against each line, and sets a a var to OK if
JLC the match is successful.
JLC All is well, but I am unclear on the correct way to loop through
JLC each line in $output, when I simply print it, it appears over
JLC several lines in the terminal.
JLC When I run it into my sub, its being treated as one line?
you need to show how you call this sub and its input. there is no way to
diagnose it from just this code.
JLC sub parse_output {
JLC foreach (@_) {
use a named variable with foreach loops. sure some docs and examples
show using the default $_ but it can have problems with action at a
distance. also a name makes the code read better.
JLC chomp($_);
if you do use $_, there is no need to pass it to many ops including
chomp. chomp by itself does the same thing.
JLC print Line: $_\n;
JLC if ( $_ =~ /$match/ ) {
again, m// will match against $_ so either don't bind to it or bind to a
named variable (or some expression).
and where does $match get set? it must be from outside the sub so it is
a global. bad!
JLC $status = OK;
same with status. either declare it locally and return it or do
something else but don't set globals just to mark something as ok
JLC next;
JLC }
JLC }
JLC }
JLC parse_output($output);
JLC It only prints one Line: although it works as it sets $status?
works in what way? if i pass it one line with something that matches, it
will pass that 'test'.
JLC What am I missing?
more code and data. use Data::Dumper to show exactly what you are
passing in.
uri
--
Uri Guttman -- u...@stemsystems.com http://www.sysarch.com --
- Perl Code Review , Architecture, Development, Training, Support --
- Gourmet Hot Cocoa Mix http://bestfriendscocoa.com -
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
RE: Feeding ouput from Net::Telnet into sub
use a named variable with foreach loops. sure some docs and examples show using the default $_ but it can have problems with action at a distance. also a name makes the code read better. Ok, simple enough to do. and where does $match get set? it must be from outside the sub so it is a global. bad! Well $match comes from Getopt::Long, it has to be global, no? Now I'm confused:) same with status. either declare it locally and return it or do something else but don't set globals just to mark something as ok Soon after posting I realized it was cleaner to return the value... more code and data. use Data::Dumper to show exactly what you are passing in. I used Data::Dumper to see what was actually being passed and it takes the following form: $VAR1 = 'system status system status: Normal hostname'; Sorry for the noobish question, but I am not sure how to interpret this? I assumed this was 4 lines of text, but I guess not? Thanks for the help! jlc -- To unsubscribe, e-mail: beginners-unsubscr...@perl.org For additional commands, e-mail: beginners-h...@perl.org http://learn.perl.org/
Re: Feeding ouput from Net::Telnet into sub
JLC == Joseph L Casale jcas...@activenetwerx.com writes: use a named variable with foreach loops. sure some docs and examples show using the default $_ but it can have problems with action at a distance. also a name makes the code read better. JLC Ok, simple enough to do. and where does $match get set? it must be from outside the sub so it is a global. bad! JLC Well $match comes from Getopt::Long, it has to be global, no? Now I'm confused:) nothing HAS to be global. you can pass it to a sub, you can store the options in a hash (my way and easy with getopt::long), etc. some globals may be useful but always using them or not know other ways is bad. same with status. either declare it locally and return it or do something else but don't set globals just to mark something as ok JLC Soon after posting I realized it was cleaner to return the value... more code and data. use Data::Dumper to show exactly what you are passing in. JLC I used Data::Dumper to see what was actually being passed and it takes JLC the following form: JLC $VAR1 = 'system status JLCsystem status: Normal JLC hostname'; JLC Sorry for the noobish question, but I am not sure how to interpret this? JLC I assumed this was 4 lines of text, but I guess not? no. it is a single string with 4 lines in it. why would you think foreach would loop over its lines vs its single string? arrays can contain strings without lines and a scalar could contain a single string with lines. so foreach is neutral and just loops over what you pass it in terms of perl elements. if you want lines, split them yourself or get them some other way. e.g. backticks in a list context will split its output into lines for you. i dunno how you are doing this telnet thing (as i said SHOW MORE/ALL CODE :). uri -- Uri Guttman -- u...@stemsystems.com http://www.sysarch.com -- - Perl Code Review , Architecture, Development, Training, Support -- - Gourmet Hot Cocoa Mix http://bestfriendscocoa.com - -- To unsubscribe, e-mail: beginners-unsubscr...@perl.org For additional commands, e-mail: beginners-h...@perl.org http://learn.perl.org/
RE: Feeding ouput from Net::Telnet into sub
nothing HAS to be global. you can pass it to a sub, you can store the
options in a hash (my way and easy with getopt::long), etc. some globals
may be useful but always using them or not know other ways is bad.
Ok, fair enough.
no. it is a single string with 4 lines in it. why would you think
foreach would loop over its lines vs its single string? arrays can
contain strings without lines and a scalar could contain a single string
with lines. so foreach is neutral and just loops over what you pass it
in terms of perl elements. if you want lines, split them yourself or get
them some other way. e.g. backticks in a list context will split its
output into lines for you. i dunno how you are doing this telnet thing
(as i said SHOW MORE/ALL CODE :).
Well the rest of the code _only_ does the telnet part and has too much
hardcoded stuff atm. It works perfectly as per cpan docs.
I'm just stuck on formatting the sub to match a string, just don't know
enough about Perl:)
I think I have it:
sub parse_output {
my ( $string, $match ) = @_;
die Error in parse_output sub\n unless ((defined $string) || (defined
$match));
if ( $string =~ /$match/ ) {
return OK;
} else {
return CRITICAL;
}
}
$status = parse_output($output, $expect);
print Status: $status\n;
From what I can see, this follows all the suggestions you have provided?
Thanks for all your help!
jlc
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
Re: Feeding ouput from Net::Telnet into sub
JLC == Joseph L Casale jcas...@activenetwerx.com writes:
nothing HAS to be global. you can pass it to a sub, you can store the
options in a hash (my way and easy with getopt::long), etc. some globals
may be useful but always using them or not know other ways is bad.
JLC Ok, fair enough.
that is true for all programming, not just perl.
JLC Well the rest of the code _only_ does the telnet part and has too much
JLC hardcoded stuff atm. It works perfectly as per cpan docs.
so it could still likely use a review. especially if you are learning
perl. many doc examples aren't written to the best coding standards.
JLC I think I have it:
JLC sub parse_output {
JLC my ( $string, $match ) = @_;
better.
JLC die Error in parse_output sub\n unless ((defined $string) ||
(defined $match));
don't put the \n in the die string so it will report the line number
too. and your boolean test is wrong. you want both to be defined. and
even defined is overkill if you know you have text and a match
string. unless either is just '' or '0' they will be true. so that line
can be:
die Error in parse_output sub unless $string $match ;
JLC if ( $string =~ /$match/ ) {
JLC return OK;
JLC } else {
JLC return CRITICAL;
JLC }
that is a very odd indent style. the returns should be indented the
same. the }else and close should be left indented one more. like this:
if ( $string =~ /$match/ ) {
return OK;
}
else {
return CRITICAL;
}
JLC $status = parse_output($output, $expect);
JLC print Status: $status\n;
From what I can see, this follows all the suggestions you have provided?
and there are more! always more. :)
uri
--
Uri Guttman -- u...@stemsystems.com http://www.sysarch.com --
- Perl Code Review , Architecture, Development, Training, Support --
- Gourmet Hot Cocoa Mix http://bestfriendscocoa.com -
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
RE: Feeding ouput from Net::Telnet into sub
so it could still likely use a review. especially if you are learning perl. many doc examples aren't written to the best coding standards. I'll take you up on that once its supposedly done:) Many great tips, thanks for all the help! jlc -- To unsubscribe, e-mail: beginners-unsubscr...@perl.org For additional commands, e-mail: beginners-h...@perl.org http://learn.perl.org/
