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
139 # Now that we are alone, we can simply exit
143 sub _restartServer() {
145 # Not sure what to do on a restart server
146 display 'Entered _restartServer';
151 sub setMultithreaded($) {
152 my ($self, $value) = @_;
154 my $oldValue = $self->{multithreaded};
156 $self->{multithreaded} = $value;
161 sub getMultithreaded() {
164 return $self->{multithreaded};
167 sub connectToServer(;$$) {
168 my ($self, $host, $port) = @_;
170 $host ||= $CLEAROPTS{CLEAREXEC_HOST};
171 $port ||= $CLEAROPTS{CLEAREXEC_PORT};
173 $self->{socket} = IO::Socket::INET->new (
179 return unless $self->{socket};
181 $self->{socket}->autoflush if $self->{socket};
183 $self->{host} = $host;
184 $self->{port} = $port;
186 if ($self->{socket}) {
195 sub disconnectFromServer() {
198 undef $self->{socket};
201 } # disconnectFromServer
204 my ($self, $cmd) = @_;
206 return (-1, 'Unable to talk to server') unless $self->{socket};
208 my ($status, $statusLine, @output) = (-1, '', ());
210 my $server = $self->{socket};
212 print $server "$cmd\n";
216 while (defined ($response = <$server>)) {
217 if ($response =~ /Clearexec Status: (-*\d+)/) {
222 push @output, $response;
227 return ($status, @output);
230 sub _serviceClient($$) {
231 my ($self, $host, $client) = @_;
233 $self->_verbose ("Serving requests from $host");
235 # Set autoflush for client
236 $client->autoflush if $client;
239 # Read command from client
248 last if $cmd =~ /quit|exit/i;
250 $self->_debug ("$host wants us to do $cmd");
252 my ($status, @output);
256 if ($cmd =~ /stopserver/i) {
257 if ($self->{server}) {
258 $self->_verbose ("$host requested to stop server [$self->{server}]");
260 # Send server hangup signal
261 kill 'HUP', $self->{server};
263 $self->_verbose ('Shutting down server');
265 print $client "Clearexec Status: 0\n";
270 $self->_debug ("Returning 0, undef");
272 # Combines STDERR -> STDOUT if not already specified
273 $cmd .= ' 2>&1' unless $cmd =~ /2>&1/;
275 $self->_debug ("Executing $cmd");
276 ($status, @output) = Execute $cmd;
277 $self->_debug ("Status: $status");
280 print $client "$_\n" for (@output);
281 print $client "Clearexec Status: $status\n";
283 $self->_debug ("Looping around for next command");
288 $self->_verbose ("Serviced requests from $host");
293 sub startServer(;$) {
294 my ($self, $port) = @_;
296 $port ||= $CLEAROPTS{CLEAREXEC_PORT};
298 # Create new socket to communicate to clients with
299 $self->{socket} = IO::Socket::INET->new (
306 error "Could not create socket - $!", 1 unless $self->{socket};
309 $self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
311 # Now wait for an incoming request
315 $client = $self->{socket}->accept;
321 error "Accept called failed (Error: $?) - $!", 1;
325 my $hostinfo = gethostbyaddr $client->peeraddr;
326 my $host = $hostinfo->name || $client->peerhost;
328 $self->_verbose ("$host is requesting service");
330 if ($self->getMultithreaded) {
331 $self->{server} = $$;
335 $self->_debug ("Spawning child to handle request");
337 error "Can't fork: $!"
338 unless defined ($childpid = fork);
343 # On Unix/Linux, setting SIGCHLD to ignore auto reaps dead children.
344 $SIG{CHLD} = "IGNORE";
345 $SIG{HUP} = \&_endServer;
346 $SIG{USR2} = \&_restartServer;
348 $self->_debug ("Parent produced child [$childpid]");
350 # In child process - ServiceClient
353 $self->_debug ("Calling _serviceClient");
354 $self->_serviceClient ($host, $client);
355 $self->_debug ("Returned from _serviceClient - exiting...");
360 $self->_serviceClient ($host, $client);
369 =head1 CONFIGURATION AND ENVIRONMENT
371 DEBUG: If set then $debug is set to this level.
373 VERBOSE: If set then $verbose is set to this level.
375 TRACE: If set then $trace is set to this level.
385 L<IO::Socket|IO::Socket>
387 L<Net::hostent|Net::hostent>
389 =head2 ClearSCM Perl Modules
402 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">Display</a><br>
403 <a href="http://clearscm.com/php/scm_man.php?file=lib/Display.pm">Display</a><br>
404 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConf</a><br>
409 =head1 BUGS AND LIMITATIONS
411 There are no known bugs in this module.
413 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
415 =head1 LICENSE AND COPYRIGHT
417 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.