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     # do nothing
 137   } # while
 138
 139   # Now that we are alone, we can simply exit
 140   exit;
 141 } # _endServer
 142
 143 sub _restartServer() {
 144
 145   # Not sure what to do on a restart server
 146   display 'Entered _restartServer';
 147
 148   return;
 149 } # _restartServer
 150
 151 sub setMultithreaded($) {
 152   my ($self, $value) = @_;
 153
 154   my $oldValue = $self->{multithreaded};
 155
 156   $self->{multithreaded} = $value;
 157
 158   return $oldValue;
 159 } # setMultithreaded
 160
 161 sub getMultithreaded() {
 162   my ($self) = @_;
 163
 164   return $self->{multithreaded};
 165 } # getMultithreaded
 166
 167 sub connectToServer(;$$) {
 168   my ($self, $host, $port) = @_;
 169
 170   $host ||= $CLEAROPTS{CLEAREXEC_HOST};
 171   $port ||= $CLEAROPTS{CLEAREXEC_PORT};
 172
 173   $self->{socket} = IO::Socket::INET->new (
 174     Proto    => 'tcp',
 175     PeerAddr => $host,
 176     PeerPort => $port,
 177   );
 178
 179   return unless $self->{socket};
 180
 181   $self->{socket}->autoflush if $self->{socket};
 182
 183   $self->{host} = $host;
 184   $self->{port} = $port;
 185
 186   if ($self->{socket}) {
 187     return 1;
 188   } else {
 189     return;
 190   } # if
 191
 192   return;
 193 } # connectToServer
 194
 195 sub disconnectFromServer() {
 196   my ($self) = @_;
 197
 198   undef $self->{socket};
 199
 200   return;
 201 } # disconnectFromServer
 202
 203 sub execute($) {
 204   my ($self, $cmd) = @_;
 205
 206   return (-1, 'Unable to talk to server') unless $self->{socket};
 207
 208   my ($status, $statusLine, @output) = (-1, '', ());
 209
 210   my $server = $self->{socket};
 211
 212   print $server "$cmd\n";
 213
 214   my $response;
 215
 216   while (defined ($response = <$server>)) {
 217     if ($response =~ /Clearexec Status: (-*\d+)/) {
 218       $status = $1;
 219       last;
 220     } # if
 221
 222     push @output, $response;
 223   } # while
 224
 225   chomp @output;
 226
 227   return ($status, @output);
 228 } # execute
 229
 230 sub _serviceClient($$) {
 231   my ($self, $host, $client) = @_;
 232
 233   $self->_verbose ("Serving requests from $host");
 234
 235   # Set autoflush for client
 236   $client->autoflush if $client;
 237
 238   while () {
 239     # Read command from client
 240     my $cmd = <$client>;
 241
 242     last unless $cmd;
 243
 244     chomp $cmd;
 245
 246     next if $cmd eq '';
 247
 248     last if $cmd =~ /quit|exit/i;
 249
 250     $self->_debug ("$host wants us to do $cmd");
 251
 252     my ($status, @output);
 253
 254     $status = 0;
 255
 256     if ($cmd =~ /stopserver/i) {
 257       if ($self->{server}) {
 258         $self->_verbose ("$host requested to stop server [$self->{server}]");
 259
 260         # Send server hangup signal
 261         kill 'HUP', $self->{server};
 262       } else {
 263         $self->_verbose ('Shutting down server');
 264
 265         print $client "Clearexec Status: 0\n";
 266
 267         exit;
 268       } # if
 269
 270       $self->_debug ("Returning 0, undef");
 271     } else {
 272       # Combines STDERR -> STDOUT if not already specified
 273       $cmd .= ' 2>&1' unless $cmd =~ /2>&1/;
 274
 275       $self->_debug ("Executing $cmd");
 276       ($status, @output) = Execute $cmd;
 277       $self->_debug ("Status: $status");
 278     } # if
 279
 280     print $client "$_\n" for (@output);
 281     print $client "Clearexec Status: $status\n";
 282
 283     $self->_debug ("Looping around for next command");
 284   } # while
 285
 286   close $client;
 287
 288   $self->_verbose ("Serviced requests from $host");
 289
 290   return;
 291 } # _serviceClient
 292
 293 sub startServer(;$) {
 294   my ($self, $port) = @_;
 295
 296   $port ||= $CLEAROPTS{CLEAREXEC_PORT};
 297
 298   # Create new socket to communicate to clients with
 299   $self->{socket} = IO::Socket::INET->new (
 300     Proto     => 'tcp',
 301     LocalPort => $port,
 302     Listen    => SOMAXCONN,
 303     Reuse     => 1
 304   );
 305
 306   error "Could not create socket - $!", 1 unless $self->{socket};
 307
 308   # Announce ourselves
 309   $self->_log ("Clearexec V$VERSION accepting clients at " . localtime);
 310
 311   # Now wait for an incoming request
 312   my $client;
 313
 314   while () {
 315     $client = $self->{socket}->accept;
 316
 317     if ($? == -1) {\r
 318       if ($!{EINTR}) {
 319         next;
 320       } else {
 321         error "Accept called failed (Error: $?) - $!", 1;
 322       } # if\r
 323     } # if
 324
 325     my $hostinfo = gethostbyaddr $client->peeraddr;
 326     my $host = $hostinfo->name || $client->peerhost;
 327
 328     $self->_verbose ("$host is requesting service");
 329
 330     if ($self->getMultithreaded) {
 331       $self->{server} = $$;
 332
 333       my $childpid;
 334
 335       $self->_debug ("Spawning child to handle request");
 336
 337       error "Can't fork: $!"
 338         unless defined ($childpid = fork);
 339
 340       if ($childpid) {
 341         $self->{pid} = $$;
 342
 343         # On Unix/Linux, setting SIGCHLD to ignore auto reaps dead children.
 344         $SIG{CHLD} = "IGNORE";
 345         $SIG{HUP}  = \&_endServer;
 346         $SIG{USR2} = \&_restartServer;
 347
 348         $self->_debug ("Parent produced child [$childpid]");
 349       } else {
 350         # In child process - ServiceClient
 351         $self->{pid} = $$;
 352
 353         $self->_debug         ("Calling _serviceClient");
 354         $self->_serviceClient ($host, $client);
 355         $self->_debug         ("Returned from _serviceClient - exiting...");
 356
 357         exit;
 358       } # if
 359     } else {
 360       $self->_serviceClient ($host, $client);
 361     } # if
 362   } # while
 363 } # startServer
 364
 365 1;
 366
 367 =pod
 368
 369 =head1 CONFIGURATION AND ENVIRONMENT
 370
 371 DEBUG: If set then $debug is set to this level.
 372
 373 VERBOSE: If set then $verbose is set to this level.
 374
 375 TRACE: If set then $trace is set to this level.
 376
 377 =head1 DEPENDENCIES
 378
 379 =head2 Perl Modules
 380
 381 L<Carp>
 382
 383 L<FindBin>
 384
 385 L<IO::Socket|IO::Socket>
 386
 387 L<Net::hostent|Net::hostent>
 388
 389 =head2 ClearSCM Perl Modules
 390
 391 =begin man
 392
 393  DateUtils
 394  Display
 395  GetConfig
 396
 397 =end man
 398
 399 =begin html
 400
 401 <blockquote>
 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>
 405 </blockquote>
 406
 407 =end html
 408
 409 =head1 BUGS AND LIMITATIONS
 410
 411 There are no known bugs in this module.
 412
 413 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 414
 415 =head1 LICENSE AND COPYRIGHT
 416
 417 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
 418
 419 =cut