clearadm/lib/Clearexec.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Clearexec.pm,v $
   4
   5 Clearexec - Execute remote commands locally
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.18 $
  18
  19 =item Created
  20
  21 Tue Dec 07 09:13:27 EST 2010
  22
  23 =item Modified
  24
  25 $Date: 2012/12/16 18:00:16 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  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
  33 back to the caller.
  34
  35 =head1 DESCRIPTION
  36
  37 The results are sent back as follows:
  38
  39  Status: <status>
  40  <command output>
  41
  42 This allows the caller to determine if the command execution was successful as
  43 well as capture the commands output.
  44
  45 =head1 ROUTINES
  46
  47 The following methods are available:
  48
  49 =cut
  50
  51 package Clearexec;
  52
  53 use strict;
  54 use warnings;
  55
  56 use Carp;
  57 use FindBin;
  58 use IO::Socket;
  59 use Net::hostent;
  60 use POSIX qw(:sys_wait_h);
  61 use Errno;
  62
  63 use lib "$FindBin::Bin/../../lib";
  64
  65 use DateUtils;
  66 use Display;
  67 use GetConfig;
  68 use Utils;
  69
  70 # Seed options from config file
  71 our %CLEAROPTS = GetConfig ("$FindBin::Bin/etc/clearexec.conf");
  72
  73 our $VERSION = '$Revision: 1.18 $';
  74 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
  75
  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};
  83
  84 sub new () {
  85   my ($class) = @_;
  86
  87   my $clearadm = bless {}, $class;
  88
  89   $clearadm->{multithreaded} = $CLEAROPTS{CLEAREXEC_MULTITHREADED};
  90
  91   return $clearadm;
  92 } # new
  93
  94 sub _tag ($) {
  95   my ($self, $msg) = @_;
  96
  97   my $tag = YMDHMS;
  98   $tag .= ' ';
  99   $tag .= $self->{pid} ? "[$self->{pid}] " : '';
 100
 101   return "$tag$msg";
 102 } # _tag
 103
 104 sub _verbose ($) {
 105   my ($self, $msg) = @_;
 106
 107   verbose $self->_tag ($msg);
 108
 109   return;
 110 } # _verbose
 111
 112 sub _debug ($) {
 113   my ($self, $msg) = @_;
 114
 115   debug $self->_tag ($msg);
 116
 117   return;
 118 } # _debug
 119
 120 sub _log ($) {
 121   my ($self, $msg) = @_;
 122
 123   display $self->_tag ($msg);
 124
 125   return;
 126 } # log
 127
 128 sub _endServer () {
 129   display "Clearexec V$VERSION shutdown at " . localtime;
 130
 131   # Kill process group
 132   kill 'TERM', -$$;
 133
 134   # Wait for all children to die
 135   while (wait != -1) {
 136
 137     # do nothing
 138   } # while
 139
 140   # Now that we are alone, we can simply exit
 141   exit;
 142 } # _endServer
 143
 144 sub _restartServer () {
 145
 146   # Not sure what to do on a restart server
 147   display 'Entered _restartServer';
 148
 149   return;
 150 } # _restartServer
 151
 152 sub setMultithreaded ($) {
 153   my ($self, $value) = @_;
 154
 155   my $oldValue = $self->{multithreaded};
 156
 157   $self->{multithreaded} = $value;
 158
 159   return $oldValue;
 160 } # setMultithreaded
 161
 162 sub getMultithreaded () {
 163   my ($self) = @_;
 164
 165   return $self->{multithreaded};
 166 } # getMultithreaded
 167
 168 sub connectToServer (;$$) {
 169   my ($self, $host, $port) = @_;
 170
 171   $host ||= $CLEAROPTS{CLEAREXEC_HOST};
 172   $port ||= $CLEAROPTS{CLEAREXEC_PORT};
 173
 174   $self->{socket} = IO::Socket::INET->new (
 175     Proto    => 'tcp',
 176     PeerAddr => $host,
 177     PeerPort => $port,
 178   );
 179
 180   return unless $self->{socket};
 181
 182   $self->{socket}->autoflush
 183     if $self->{socket};
 184
 185   $self->{host} = $host;
 186   $self->{port} = $port;
 187
 188   if ($self->{socket}) {
 189     return 1;
 190   } else {
 191     return;
 192   } # if
 193
 194   return;
 195 } # connectToServer
 196
 197 sub disconnectFromServer () {
 198   my ($self) = @_;
 199
 200   undef $self->{socket};
 201
 202   return;
 203 } # disconnectFromServer
 204
 205 sub execute ($) {
 206   my ($self, $cmd) = @_;
 207
 208   return (-1, 'Unable to talk to server')
 209     unless $self->{socket};
 210
 211   my ($status, $statusLine, @output) = (-1, '', ());
 212
 213   my $server = $self->{socket};
 214
 215   print $server "$cmd\n";
 216
 217   my $response;
 218
 219   while (defined ($response = <$server>)) {
 220     if ($response =~ /Clearexec Status: (-*\d+)/) {
 221       $status = $1;
 222       last;
 223     } # if
 224
 225     push @output, $response;
 226   } # while
 227
 228   chomp @output;
 229
 230   return ($status, @output);
 231 } # execute
 232
 233 sub _serviceClient ($$) {
 234   my ($self, $host, $client) = @_;
 235
 236   $self->_verbose ("Serving requests from $host");
 237
 238   # Set autoflush for client
 239   $client->autoflush
 240     if $client;
 241
 242   while () {
 243     # Read command from client
 244     my $cmd = <$client>;
 245
 246     last unless $cmd;
 247
 248     chomp $cmd;
 249
 250     next if $cmd eq '';
 251
 252     last if $cmd =~ /quit|exit/i;
 253
 254     $self->_debug ("$host wants us to do $cmd");
 255
 256     my ($status, @output);
 257
 258     $status = 0;
 259
 260     if ($cmd =~ /stopserver/i) {
 261       if ($self->{server}) {
 262         $self->_verbose ("$host requested to stop server [$self->{server}]");
 263
 264         # Send server hangup signal
 265         kill 'HUP', $self->{server};
 266       } else {
 267         $self->_verbose ('Shutting down server');
 268
 269         print $client "Clearexec Status: 0\n";
 270
 271         exit;
 272       } # if
 273
 274       $self->_debug ("Returning 0, undef");
 275     } else {
 276       # Combines STDERR -> STDOUT if not already specified
 277       $cmd .= ' 2>&1'
 278         unless $cmd =~ /2>&1/;
 279
 280       $self->_debug ("Executing $cmd");
 281       ($status, @output) = Execute $cmd;
 282       $self->_debug ("Status: $status");
 283     } # if
 284
 285     print $client "$_\n" foreach (@output);
 286     print $client "Clearexec Status: $status\n";
 287
 288     $self->_debug ("Looping around for next command");
 289   } # while
 290
 291   close $client;
 292
 293   $self->_verbose ("Serviced requests from $host");
 294
 295   return;
 296 } # _serviceClient
 297
 298 sub startServer (;$) {
 299   my ($self, $port) = @_;
 300
 301   $port ||= $CLEAROPTS{CLEAREXEC_PORT};
 302
 303   # Create new socket to communicate to clients with
 304   $self->{socket} = IO::Socket::INET->new (
 305     Proto     => 'tcp',
 306     LocalPort => $port,
 307     Listen    => SOMAXCONN,
 308     Reuse     => 1
 309   );
 310
 311   error "Could not create socket - $!", 1
 312     unless $self->{socket};
 313
 314   # Announce ourselves
 315   $self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
 316
 317   # Now wait for an incoming request
 318   my $client;
 319
 320   while () {
 321     $client = $self->{socket}->accept;
 322
 323     if ($? == -1) {\r
 324       if ($!{EINTR}) {
 325         next;
 326       } else {
 327         error "Accept called failed (Error: $?) - $!", 1;
 328       } # if\r
 329     } # if
 330
 331     my $hostinfo = gethostbyaddr $client->peeraddr;
 332     my $host = $hostinfo->name || $client->peerhost;
 333
 334     $self->_verbose ("$host is requesting service");
 335
 336     if ($self->getMultithreaded) {
 337       $self->{server} = $$;
 338
 339       my $childpid;
 340
 341       $self->_debug ("Spawning child to handle request");
 342
 343       error "Can't fork: $!"
 344         unless defined ($childpid = fork);
 345
 346       if ($childpid) {
 347         $self->{pid} = $$;
 348
 349         # On Unix/Linux, setting SIGCHLD to ignore auto reaps dead children.
 350         $SIG{CHLD} = "IGNORE";
 351         $SIG{HUP}  = \&_endServer;
 352         $SIG{USR2} = \&_restartServer;
 353
 354         $self->_debug ("Parent produced child [$childpid]");
 355       } else {
 356         # In child process - ServiceClient
 357         $self->{pid} = $$;
 358
 359         $self->_debug         ("Calling _serviceClient");
 360         $self->_serviceClient ($host, $client);
 361         $self->_debug         ("Returned from _serviceClient - exiting...");
 362
 363         exit;
 364       } # if
 365     } else {
 366       $self->_serviceClient ($host, $client);
 367     } # if
 368   } # while
 369 } # startServer
 370
 371 1;
 372
 373 =pod
 374
 375 =head1 CONFIGURATION AND ENVIRONMENT
 376
 377 DEBUG: If set then $debug is set to this level.
 378
 379 VERBOSE: If set then $verbose is set to this level.
 380
 381 TRACE: If set then $trace is set to this level.
 382
 383 =head1 DEPENDENCIES
 384
 385 =head2 Perl Modules
 386
 387 L<Carp>
 388
 389 L<FindBin>
 390
 391 L<IO::Socket|IO::Socket>
 392
 393 L<Net::hostent|Net::hostent>
 394
 395 =head2 ClearSCM Perl Modules
 396
 397 =begin man
 398
 399  DateUtils
 400  Display
 401  GetConfig
 402
 403 =end man
 404
 405 =begin html
 406
 407 <blockquote>
 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>
 411 </blockquote>
 412
 413 =end html
 414
 415 =head1 BUGS AND LIMITATIONS
 416
 417 There are no known bugs in this module.
 418
 419 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 420
 421 =head1 LICENSE AND COPYRIGHT
 422
 423 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
 424
 425 =cut