Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 taking refuge in the Monastery: (12)
    As of 2015-07-28 22:30 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (260 votes), past polls