3 =head1 NAME $RCSfile: Clearexec.pm,v $
5 Clearexec - Execute remote commands locally
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Tue Dec 07 09:13:27 EST 2010
25 $Date: 2012/12/16 18:00:16 $
31 Provides an interface to the Clearexec object. Clearexec is a daemon that runs
32 on a host and accepts requests to execute commands locally and send the results
37 The results are sent back as follows:
42 This allows the caller to determine if the command execution was successful as
43 well as capture the commands output.
47 The following methods are available:
60 use POSIX qw(:sys_wait_h);
63 use lib "$FindBin::Bin/../../lib";
70 # Seed options from config file
71 our %CLEAROPTS = GetConfig ("$FindBin::Bin/etc/clearexec.conf");
73 our $VERSION = '$Revision: 1.18 $';
74 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
76 # Override options if in the environment
77 $CLEAROPTS{CLEAREXEC_HOST} = $ENV{CLEAREXEC_HOST}
78 if $ENV{CLEAREXEC_HOST};
79 $CLEAROPTS{CLEAREXEC_PORT} = $ENV{CLEAREXEC_PORT}
80 if $ENV{CLEAREXEC_PORT};
81 $CLEAROPTS{CLEAREXEC_MULTITHREADED} = $ENV{CLEAREXEC_MULTITHREADED}
82 if $ENV{CLEAREXEC_MULTITHREADED};
87 my $clearadm = bless {}, $class;
89 $clearadm->{multithreaded} = $CLEAROPTS{CLEAREXEC_MULTITHREADED};
95 my ($self, $msg) = @_;
99 $tag .= $self->{pid} ? "[$self->{pid}] " : '';
105 my ($self, $msg) = @_;
107 verbose $self->_tag ($msg);
113 my ($self, $msg) = @_;
115 debug $self->_tag ($msg);
121 my ($self, $msg) = @_;
123 display $self->_tag ($msg);
129 display "Clearexec V$VERSION shutdown at " . localtime;
134 # Wait for all children to die
140 # Now that we are alone, we can simply exit
144 sub _restartServer () {
146 # Not sure what to do on a restart server
147 display 'Entered _restartServer';
152 sub setMultithreaded ($) {
153 my ($self, $value) = @_;
155 my $oldValue = $self->{multithreaded};
157 $self->{multithreaded} = $value;
162 sub getMultithreaded () {
165 return $self->{multithreaded};
168 sub connectToServer (;$$) {
169 my ($self, $host, $port) = @_;
171 $host ||= $CLEAROPTS{CLEAREXEC_HOST};
172 $port ||= $CLEAROPTS{CLEAREXEC_PORT};
174 $self->{socket} = IO::Socket::INET->new (
180 return unless $self->{socket};
182 $self->{socket}->autoflush
185 $self->{host} = $host;
186 $self->{port} = $port;
188 if ($self->{socket}) {
197 sub disconnectFromServer () {
200 undef $self->{socket};
203 } # disconnectFromServer
206 my ($self, $cmd) = @_;
208 return (-1, 'Unable to talk to server')
209 unless $self->{socket};
211 my ($status, $statusLine, @output) = (-1, '', ());
213 my $server = $self->{socket};
215 print $server "$cmd\n";
219 while (defined ($response = <$server>)) {
220 if ($response =~ /Clearexec Status: (-*\d+)/) {
225 push @output, $response;
230 return ($status, @output);
233 sub _serviceClient ($$) {
234 my ($self, $host, $client) = @_;
236 $self->_verbose ("Serving requests from $host");
238 # Set autoflush for client
243 # Read command from client
252 last if $cmd =~ /quit|exit/i;
254 $self->_debug ("$host wants us to do $cmd");
256 my ($status, @output);
260 if ($cmd =~ /stopserver/i) {
261 if ($self->{server}) {
262 $self->_verbose ("$host requested to stop server [$self->{server}]");
264 # Send server hangup signal
265 kill 'HUP', $self->{server};
267 $self->_verbose ('Shutting down server');
269 print $client "Clearexec Status: 0\n";
274 $self->_debug ("Returning 0, undef");
276 # Combines STDERR -> STDOUT if not already specified
278 unless $cmd =~ /2>&1/;
280 $self->_debug ("Executing $cmd");
281 ($status, @output) = Execute $cmd;
282 $self->_debug ("Status: $status");
285 print $client "$_\n" foreach (@output);
286 print $client "Clearexec Status: $status\n";
288 $self->_debug ("Looping around for next command");
293 $self->_verbose ("Serviced requests from $host");
298 sub startServer (;$) {
299 my ($self, $port) = @_;
301 $port ||= $CLEAROPTS{CLEAREXEC_PORT};
303 # Create new socket to communicate to clients with
304 $self->{socket} = IO::Socket::INET->new (
311 error "Could not create socket - $!", 1
312 unless $self->{socket};
315 $self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
317 # Now wait for an incoming request
321 $client = $self->{socket}->accept;
327 error "Accept called failed (Error: $?) - $!", 1;
331 my $hostinfo = gethostbyaddr $client->peeraddr;
332 my $host = $hostinfo->name || $client->peerhost;
334 $self->_verbose ("$host is requesting service");
336 if ($self->getMultithreaded) {
337 $self->{server} = $$;
341 $self->_debug ("Spawning child to handle request");
343 error "Can't fork: $!"
344 unless defined ($childpid = fork);
349 # On Unix/Linux, setting SIGCHLD to ignore auto reaps dead children.
350 $SIG{CHLD} = "IGNORE";
351 $SIG{HUP} = \&_endServer;
352 $SIG{USR2} = \&_restartServer;
354 $self->_debug ("Parent produced child [$childpid]");
356 # In child process - ServiceClient
359 $self->_debug ("Calling _serviceClient");
360 $self->_serviceClient ($host, $client);
361 $self->_debug ("Returned from _serviceClient - exiting...");
366 $self->_serviceClient ($host, $client);
375 =head1 CONFIGURATION AND ENVIRONMENT
377 DEBUG: If set then $debug is set to this level.
379 VERBOSE: If set then $verbose is set to this level.
381 TRACE: If set then $trace is set to this level.
391 L<IO::Socket|IO::Socket>
393 L<Net::hostent|Net::hostent>
395 =head2 ClearSCM Perl Modules
408 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">Display</a><br>
409 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
410 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConf</a><br>
415 =head1 BUGS AND LIMITATIONS
417 There are no known bugs in this module.
419 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
421 =head1 LICENSE AND COPYRIGHT
423 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.