Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Hi guys, i've written a kind of socket listener to execute commands on remote machines. The listener waits for an incoming (HTTP) call and then basically executes a command.
My Problem is that I cannot manage it to be multithreaded. Your can fire 10 requests right away, but they will be processed one by one and not in parallel. I am using a browser to send the request.
I am already forking children to archieve this, but for some reason it won't work.

I know it's a big piece of code and looks ugly here. Sorry for this.
If somebody has a hint for me - I would be very thankful :O)
#!/usr/bin/perl use lib "lib"; use warnings; use Cwd; use Time::Local; use File::stat; use Config::Properties; use Log::Log4perl; use IO::Socket; # for OO version of gethostbyaddr use Net::hostent; use POSIX 'setsid'; # flush after every write $| = 1; # change to script directory in any case my $script_dir = $0; $script_dir =~ s/[\\|\/]PRTG_adapter\.pl$//; chdir $script_dir; # open central configuration my $props_main = "conf\/main.cfg"; unless ( -e $props_main ) { print "cannot load main configuration(conf/main.cfg) !\n"; exit 1; } open my $fh, "<:encoding(UTF8)", $props_main or die "unable to open c +onfiguration file: $props_main"; # load properties my $properties_main = Config::Properties->new(); $properties_main->load($fh); close $fh; # init log4perl Log::Log4perl::init($properties_main->getProperty('log_config')); my $logger = Log::Log4perl->get_logger('PRTG_adapter'); my $lock_file = $properties_main->getProperty('lock_file'); if ( $#ARGV == 0 ) { if ( $ARGV[0] eq 'start' ) { start(); } elsif ( $ARGV[0] eq 'stop' ) { stop(); } elsif ( $ARGV[0] eq 'status' ) { status(); } elsif ( $ARGV[0] eq 'restart' ) { stop(); start(); } else { print "usage: PRTG_adapter.pl start|stop|status\n"; exit 2; } } else { print "usage: PRTG_adapter.pl start|stop|status\n"; exit 2; } sub start { print "starting process\n"; # check if process is running already if ( -e $lock_file ) { eval { open FILE, "<$lock_file" or die $!; }; if ($@) { print "cannot open the pid file: $@ !\n"; } my $pid = <FILE>; close(FILE); my $exists = kill 0, $pid; if ( $exists ) { print "found a running process running with pid $pid !\n"; exit 2; } else { print "found *NO* process running with pid $pid !\n"; print "delete the lock file manually before you proceed.\n"; print "lock file: $lock_file"; exit 2; } } else { # fork a child my $child = fork(); unless ( defined $child ) { print "cannot fork child process !\n"; exit 2; } if ( $child ) { # parent is exiting now print "detaching child process\n"; exit 0; } else { # detach child process from parent setsid; eval { open(FILE,">$lock_file"); }; if ($@) { print "cannot open the pid file for writing: $@ !\n"; } print FILE $$; close(FILE); } } } sub stop { if ( -e $lock_file ) { eval { open FILE, "<$lock_file" or die $!; }; if ($@) { print "cannot open the pid file: $@ !\n"; exit 2; } my $pid = <FILE>; close(FILE); my $exists = kill 0, $pid; if ( $exists ) { print "found a running process running with pid $pid !\n"; print "stopping process"; for ( my $i = 1; $i <= 10; $i++ ) { $exists = kill 0, $pid; if ( $exists ) { print "."; kill("QUIT",$pid); kill("TERM",$pid); sleep 1; } else { print "\nprocess stopped.\n"; unlink($lock_file); unless ( $ARGV[0] eq 'restart') { exit 0; } return; } } print "\nprocess wont't stop !\n"; exit 2; } else { print "found *NO* process running with pid $pid !\n"; print "delete the lock file manually before you proceed.\n"; print "lock file: $lock_file"; exit 2; } } else { print "no lockfile existing!\n"; exit 2; } } sub status { if ( -e $lock_file ) { eval { open FILE, "<$lock_file" or die $!; }; if ($@) { print "cannot open the pid file: $@ !\n"; exit 2; } my $pid = <FILE>; close(FILE); my $exists = kill 0, $pid; if ( $exists ) { print "process is running with pid " . $pid . "\n"; exit 0; } else { print "lockfile found with pid " . $pid . ", BUT no process r +unning !\n"; exit 2; } } else { print "found no lockfile. service seems to be stopped\n"; exit 0; } } # setup our tiny server $logger->debug("initiating listener"); my $server = IO::Socket::INET->new( Proto => "tcp", LocalPort => $properties_main->get +Property('listener_port'), Listen => "5", Reuse => "1"); unless ( $server ) { $logger->error("can't setup server"); exit 2; } $logger->info("Server $0 accepting clients at http://localhost:" . $pr +operties_main->getProperty('listener_port')); # start listening for requests while ( $client = $server->accept() ) { $logger->debug("forking child now"); # avoid zombies $SIG{CHLD} = 'IGNORE'; my $child = fork(); local $SIG{CHLD}; if ( $child ) { # parent can close client now $logger->debug("this is parent process closing client now"); $client->close(); $logger->debug("parent closed client"); } else { $logger->debug("this is child"); my @resultfiles; my @max_exec_secs; $logger->debug("incoming request from " . $client->peerhost() . + "(Port: " . $client->peerport() . ")" ); $client->autoflush(1); my $request = <$client>; $logger->debug("requested: " . $request ); # if we receive a vaild request my $valid_request = $properties_main->getProperty('valid_reques +t'); if ( $request =~ m/$valid_request/ ) { # store the html result here my $html_output = ""; # build a summary at the end my $counter = 0; # open properties file my $props_file = "properties/" . $1 . ".prop"; $logger->debug("configuration to load: " . $props_file); if ( -e $props_file ) { $logger->debug( "found configuration." ); } else { my $message = "error = no such configuration found(" . $p +rops_file .") skipping."; $logger->warn( $message ); print $client $message; close $client; next; } open my $fh, "<:encoding(UTF8)", $props_file or die "unable + to open configuration file: $props_file"; # load properties my $properties = Config::Properties->new(); $properties->load($fh); close $fh; # build a list of files to check for (my $i=1; $i < 30; $i++) { my $current_resultfile = "resultfile" . $i; my $current_max_exec_sec = "max_exec_sec" . $i; if ( $properties->getProperty($current_resultfile) && $pr +operties->getProperty($current_max_exec_sec) ) { $logger->debug( "commandline : " . $properties->get +Property($current_resultfile) ); $logger->debug( "exec time limit: " . $properties->get +Property($current_max_exec_sec) ); if ( $properties->getProperty($current_max_exec_sec) > + 10 ) { $logger->warn("max execution time limit of " . $pr +operties->getProperty($current_max_exec_sec) . " is too high."); $logger->warn("using 10 seconds instead"); push(@max_exec_secs , 10); } else { push(@max_exec_secs , $properties->getProperty($cur +rent_max_exec_sec)); } push(@resultfiles , $properties->getProperty($curren +t_resultfile)); } else { last; } } # if list of logsfiles is empty abort if ( $#resultfiles < 0 ) { my $message = "error = no files found to process. skippin +g."; $logger->warn( $message ); print $client $message; close $client; next; } # remove newlines in file list foreach $file (@resultfiles) { chomp($file); } # loop the resultfiles array for (my $i=0; $i <= $#resultfiles; $i++) { my $resultfile = $resultfiles[$i]; my $max_exec_sec = $max_exec_secs[$i]; # exit codes of commandline execution my $exitcode; my $exitcode_native; eval { # set alarm signal handler local $SIG{ALRM} = sub {die "execution timelimit excee +ded $!"}; # set alarm timeout to 2 seconds alarm($max_exec_sec); # execute external command here ! my $command = $resultfile; # fetch output into array @data = `$command`; # save the exitcode(s) $exitcode = $?; $exitcode_native = ${^CHILD_ERROR_NATIVE}; # unset alarm timer alarm(0); $logger->debug("returncode: " . $?); $logger->debug("child native exitcode: " . ${^CHILD_ER +ROR_NATIVE}); # verify successfull exection if ( $exitcode != 0 || $exitcode_native != 0) { die "unsuccessfull execution $!"; } # if we have been successfull else { foreach my $line( @data ) { chomp($line); $logger->debug($line); # check if the resultline matches our expected f +ormat if ( $line =~ / *([A-Za-z0-9_\-]+) += +([0-9]+) +*/) { $logger->debug("variable: $1, value: $2"); $counter = $counter + $2; } else { $logger->error("current item to process: $lin +e"); die "unexpected output format"; } $html_output = $html_output . $line . "\n"; } } }; # catch errors if ( $@ ) { # response timed out if ( $@ =~ /execution timelimit exceeded/ ) { $message = "the external script takes too much time + to respond"; $logger->error($message); $html_output = "error = " . $message ."\n"; last; } # exitcode not ok elsif ( $@ =~ /unsuccessfull execution/ ) { $message = "the external script returned an errorst +atus"; $logger->error($message); $logger->error("statuscode: $exitcode($exitcode_nat +ive)"); $html_output = "error = " . $message ."\n"; last; } elsif ( $@ =~ /unexpected output format/ ) { $message = "unexpected output format from external +script"; $logger->error($message); $html_output = "error = " . $message ."\n"; last; } # another error occured else { $message = "internal error calling external script" +; $logger->error($message); $logger->error("statuscode: $exitcode($exitcode_nat +ive)"); $html_output = "error = " . $message ."\n"; last; } } } # print the summmary unless ( $html_output =~ "error" ) { $html_output = $html_output . "TOTAL = $counter\n"; } # send html output to client print $client $html_output; $logger->debug("html output: " . $html_output); } else { print $client "error = invalid request"; $logger->warn("received invalid request. Skipping"); } $client->close(); $server->close(); undef(@resultfiles); CORE::exit(0); } if ( $child ) { # parent can close client now $logger->debug("Here is the parent process at the end of the +loop"); } }

In reply to Multithreaded Socket Listener by hoggle64

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others perusing the Monastery: (15)
    As of 2014-07-30 08:46 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (229 votes), past polls