lib/Rexec.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Rexec.pm,v $
   4
   5 Execute commands remotely and returning the output and status of the
   6 remotely executed command.
   7
   8 =head1 VERSION
   9
  10 =over
  11 =item Author:
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision:
  16
  17 $Revision: 1.21 $
  18
  19 =item Created:
  20
  21 Mon Oct  9 18:28:28 CDT 2006
  22
  23 =item Modified:
  24
  25 $Date: 2012/04/07 00:39:48 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31   use Rexec;
  32
  33   my $status;
  34   my $cmd;
  35   my @lines;
  36
  37   my $remote = new Rexec (host => $host);
  38
  39   if ($remote) {
  40     print "Connected using " . $remote->{protocol} . " protocol\n";
  41
  42     $cmd = "ls /tmp";
  43     @lines = $remote->execute ($cmd);
  44     $status = $remote->status;
  45     print "$cmd status: $status\n";
  46     $remote->print_lines;
  47
  48     print "$_\n" foreach ($remote->execute ("cat /etc/passwd"));
  49   } else {
  50     print "Unable to connect to $username\@$host\n";
  51   } # if
  52
  53 =head1 DESCRIPTION
  54
  55 This module provides an object oriented interface to executing remote
  56 commands on Linux/Unix system (or potentially well configured Windows
  57 machines with Cygwin installed). Upon object creation a connection is
  58 attempted to the specified host in a cascaded fashion. First ssh is
  59 attempted, then rsh/rlogin and finally telnet. This clearly favors
  60 secure methods over those less secure ones. If username or password is
  61 prompted for, and if they are supplied, then they are used, otherwise
  62 the attempted connection is considered failed.
  63
  64 Once connected the caller can use the exec method to execute commands
  65 on the remote host. Upon object destruction the connection is
  66 shutdown. Output from the remotely executed command is returned
  67 through the exec method and also avaiable view the lines
  68 method. Remote status is available via the status method. This means
  69 you can now more reliably obtain the status of the command executed
  70 remotely instead of just the status of the ssh/rsh command itself.
  71
  72 Note: Currently no attempt has been made to differentiate output
  73 written to stdout and stderr.
  74
  75 As Expect is used to drive the remote session particular attention
  76 should be defining a regex to locate the prompt. The standard prompt
  77 regex (if not specified by the caller at object creation) is
  78
  79 qr'[#>:$](\s*|\e.+)$'.
  80
  81 This covers most default and common prompts.
  82
  83 =head1 Handling Timeouts
  84
  85 The tricky thing when dealing with remote execution is attempting to
  86 determine if the remote machine has finished, stopped responding or
  87 otherwise crashed. It's more of an art than a science! The best one
  88 can do it send the command along and wait for a response. But how long
  89 to wait is the question. If your wait is too short then you run the
  90 risk of timing out before the remote command is finished. If you wait
  91 too long then you can be possibly waiting for something that will not
  92 be happening because the remote machine is either down or did not
  93 behave in a manner that you expected it to.
  94
  95 To a large extent this module attempts to mitigate these issues on the
  96 principal that remote command execution is pretty well known. You log
  97 in and get a prompt. Issue a command and get another prompt. If the
  98 prompts are well known and easily determinable things go smoothly.
  99 However what happens if you execute a command remotely that will take
 100 30 minutes to finish?
 101
 102 This module has two timeout values. The first is login timeout. It's
 103 assumed that logins should happen fairly quickly. The default timeout
 104 for logins is 5 seconds.
 105
 106 Command timeouts are set by default to 30 seconds. Most commands will
 107 finish before then. If you expect a command to take much longer then
 108 you can set an alternate timeout period.
 109
 110 You can achieve longer timeouts in several ways. To give a longer
 111 login timeout specify your timeout to the new call. To give a longer
 112 exec timeout either pass a longer timeout to exec or set it view
 113 setTimeout. The current exec timeout is returned by getTimeout.
 114
 115 =head1 METHODS
 116
 117 The following routines are exported:
 118
 119 =cut
 120
 121 package Rexec;
 122
 123 use strict;
 124 use warnings;
 125
 126 use base 'Exporter';
 127
 128 use Carp;
 129 use Expect;
 130
 131 our $VERSION = '1.0';
 132
 133 # This is the "normal" definition of a prompt. However what's normal?
 134 # For example, my prompt it typically the machine name followed by a
 135 # colon. But even that appears in error messages such as <host>: not
 136 # found and will be mistaken for a prompt. No real good way to handle
 137 # this so we define a standard prompt here and allow the caller to
 138 # override that. But overriding it is tricky and left as an exercise
 139 # to the caller.
 140
 141 # Here we have a number of the common prompt characters [#>:%$]
 142 # followed by zero or more spaces and end of line.
 143 our $DEFAULT_PROMPT = qr'[#>:%$](\s*|\e.+)$';
 144
 145 my $default_login_timeout = 5;
 146 my $default_exec_timeout  = 30;
 147
 148 my $debug = $ENV{DEBUG} || 0;
 149
 150 our @EXPORT = qw (
 151   exec
 152   host
 153   lines
 154   login
 155   logout
 156   new
 157   print_lines
 158   status
 159 );
 160
 161 my @lines;
 162
 163 sub _debug ($) {
 164   my ($msg) = @_;
 165
 166   my $logfile = "/tmp/rexex_debug.log";
 167
 168   open my $file, '>>', $logfile or croak "Unable to open $logfile for writing - $!";
 169
 170   print $file "DEBUG: $msg\n";
 171
 172   close $file;
 173
 174   return;
 175 } # _debug
 176
 177 sub ssh {
 178   my ($self) = shift;
 179
 180   my ($logged_in, $timedout, $password_attempts) = 0;
 181
 182   $self->{protocol} = 'ssh';
 183
 184   my $user = $self->{username} ? "$self->{username}\@" : '';
 185
 186   my $remote = Expect->new ("ssh $self->{opts} $user$self->{host}");
 187
 188   return unless $remote;
 189
 190   $remote->log_user ($debug);
 191
 192   $remote->expect (
 193     $self->{timeout},
 194
 195     # If password is prompted for, and if one has been specified, then
 196     # use it
 197     [ qr "[P|p]assword: $",
 198       sub {
 199         # If we already supplied the password then it must not have
 200         # worked so this protocol is no good.
 201         return if $password_attempts;
 202
 203         my $exp = shift;
 204
 205         # If we're being prompted for password and there is no
 206         # password to supply then there is nothing much we can do but
 207         # return undef since we can't get in with this protocol
 208         return unless $self->{password};
 209
 210         $exp->send ("$self->{password}\n") if $self->{password};
 211         $password_attempts++;
 212
 213         exp_continue;
 214       }
 215     ],
 216
 217     # Discard lines that begin with "ssh:" (like "ssh: <host>: not
 218     # found")
 219     [ qr'\nssh: ',
 220       sub {
 221         return;
 222       }
 223     ],
 224
 225     # If we find a prompt then everything's good
 226     [ $self->{prompt},
 227       sub {
 228         $logged_in = 1;
 229       }
 230     ],
 231
 232     # Of course we may time out...
 233     [ timeout =>
 234       sub {
 235         $timedout = 1;
 236       }
 237     ],
 238   );
 239
 240   if ($logged_in) {
 241     # It's always hard to find the prompt. So let's make a distintive one
 242     $self->{prompt} = "\n@@@";
 243     $self->{handle} = $remote;
 244
 245     # OK this is real tricky. If we call execute with a command of PS1=@@@
 246     # and we've changed our prompt to '@@@' then we'll see the '@@@' in the
 247     # PS1=@@@ statement as the prompt! That'll screw us up so we instead say
 248     # PS1=\@\@\@. The shell then removes the extra backslashes for us and sets
 249     # the prompt to just "@@@" for us. We catch that as our prompt and now we
 250     # have a unique prompt that we can easily recognize.
 251     if ($self->{shellstyle} eq 'sh') {
 252       $self->execute ('PS1=\@\@\@');
 253     } else {
 254       $self->execute ('set prompt=\@\@\@');
 255     } # if
 256
 257     $self->{handle}->flush;
 258     return $remote;
 259   } elsif ($timedout) {
 260     carp "WARNING: $self->{host} is not responding to $self->{protocol} protocol";
 261     undef $remote;
 262     return;
 263   } else {
 264     carp "WARNING: Unable to connect to $self->{host} using $self->{protocol} protocol";
 265     return;
 266   } # if
 267 } # ssh
 268
 269 sub rlogin {
 270   my ($self) = shift;
 271
 272   my ($logged_in, $timedout, $password_attempts) = 0;
 273
 274   $self->{protocol} = "rlogin";
 275
 276   my $user = $self->{username} ? "-l $self->{username}" : "";
 277
 278   my $remote = Expect->new ("rsh $user $self->{host}");
 279
 280   return unless $remote;
 281
 282   $remote->log_user ($debug);
 283
 284   $remote->expect (
 285     $self->{timeout},
 286
 287     # If password is prompted for, and if one has been specified, then
 288     # use it
 289     [ qr "[P|p]assword: $",
 290       sub {
 291         # If we already supplied the password then it must not have
 292         # worked so this protocol is no good.
 293         return if $password_attempts;
 294
 295         my $exp = shift;
 296
 297         # If we're being prompted for password and there is no
 298         # password to supply then there is nothing much we can do but
 299         # return undef since we can't get in with this protocol
 300         return unless $self->{password};
 301
 302         $exp->send ("$self->{password}\n");
 303         $password_attempts++;
 304
 305         exp_continue;
 306       }
 307     ],
 308
 309     # HACK! rlogin may return "<host>: unknown host" which clashes
 310     # with some prompts (OK it clashes with my prompt...)
 311     [ ": unknown host",
 312       sub {
 313         return;
 314       }
 315     ],
 316
 317     # If we find a prompt then everything's good
 318     [ $self->{prompt},
 319       sub {
 320         $logged_in = 1;
 321       }
 322     ],
 323
 324     # Of course we may time out...
 325     [ timeout =>
 326       sub {
 327         $timedout = 1;
 328       }
 329     ],
 330   );
 331
 332   if ($logged_in) {
 333     # It's always hard to find the prompt. So let's make a distintive one
 334     $self->{prompt} = '@@@';
 335     $self->{handle} = $remote;
 336
 337     # OK this is real tricky. If we call execute with a command of PS1=@@@
 338     # and we've changed our prompt to '@@@' then we'll see the '@@@' in the
 339     # PS1=@@@ statement as the prompt! That'll screw us up so we instead say
 340     # PS1=\@\@\@. The shell then removes the extra backslashes for us and sets
 341     # the prompt to just "@@@" for us. We catch that as our prompt and now we
 342     # have a unique prompt that we can easily recognize.
 343     if ($self->{shellstyle} eq 'sh') {
 344       $self->execute ('PS1=\@\@\@');
 345     } else {
 346       $self->execute ('set prompt=\@\@\@');
 347     } # if
 348
 349     return $remote;
 350   } elsif ($timedout) {
 351     carp "WARNING: $self->{host} is not responding to $self->{protocol} protocol";
 352     undef $remote;
 353     return;
 354   } else {
 355     carp "WARNING: Unable to connect to $self->{host} using $self->{protocol} protocol";
 356     return;
 357   } # if
 358 } # rlogin
 359
 360 sub telnet {
 361   my ($self) = shift;
 362
 363   my ($logged_in, $timedout, $password_attempts) = 0;
 364
 365   $self->{protocol} = "telnet";
 366
 367   my $remote = Expect->new ("telnet $self->{host}");
 368
 369   return unless $remote;
 370
 371   $remote->log_user ($debug);
 372
 373   $remote->expect (
 374     $self->{timeout},
 375
 376     # If login is prompted for, and if what has been specified, then
 377     # use it
 378     [ qr "login: $",
 379       sub {
 380         my $exp = shift;
 381
 382         # If we're being prompted for username and there is no
 383         # username to supply then there is nothing much we can do but
 384         # return undef since we can't get in with this protocol
 385         return unless $self->{username};
 386
 387         $exp->send ("$self->{username}\n");
 388         exp_continue;
 389       }
 390     ],
 391
 392     # If password is prompted for, and if one has been specified, then
 393     # use it
 394     [ qr "[P|p]assword: $",
 395       sub {
 396         # If we already supplied the password then it must not have
 397         # worked so this protocol is no good.
 398         return if $password_attempts;
 399
 400         my $exp = shift;
 401
 402         # If we're being prompted for password and there is no
 403         # password to supply then there is nothing much we can do but
 404         # return undef since we can't get in with this protocol
 405         return unless $self->{password};
 406
 407         $exp->send ("$self->{password}\n");
 408         $password_attempts++;
 409
 410         exp_continue;
 411       }
 412     ],
 413
 414     # HACK! rlogin may return "<host>: Unknown host" which clashes
 415     # with some prompts (OK it clashes with my prompt...)
 416     [ ": Unknown host",
 417       sub {
 418         return;
 419       }
 420     ],
 421
 422     # If we find a prompt then everything's good
 423     [ $self->{prompt},
 424       sub {
 425         $logged_in = 1;
 426       }
 427     ],
 428
 429     # Of course we may time out...
 430     [ timeout =>
 431       sub {
 432         $timedout = 1;
 433       }
 434     ],
 435   );
 436
 437   if ($logged_in) {
 438     # It's always hard to find the prompt. So let's make a distintive one
 439     $self->{prompt} = '@@@';
 440     $self->{handle} = $remote;
 441
 442     # OK this is real tricky. If we call execute with a command of PS1=@@@
 443     # and we've changed our prompt to '@@@' then we'll see the '@@@' in the
 444     # PS1=@@@ statement as the prompt! That'll screw us up so we instead say
 445     # PS1=\@\@\@. The shell then removes the extra backslashes for us and sets
 446     # the prompt to just "@@@" for us. We catch that as our prompt and now we
 447     # have a unique prompt that we can easily recognize.
 448     if ($self->{shellstyle} eq 'sh') {
 449       $self->execute ('PS1=\@\@\@');
 450     } else {
 451       $self->execute ('set prompt=\@\@\@');
 452     } # if
 453
 454     return $remote;
 455   } elsif ($timedout) {
 456     carp "WARNING: $self->{host} is not responding to $self->{protocol} protocol";
 457     undef $remote;
 458     return;
 459   } else {
 460     carp "WARNING: Unable to connect to $self->{host} using $self->{protocol} protocol";
 461     return;
 462   } # if
 463 } # telnet
 464
 465 sub login () {
 466   my ($self) = shift;
 467
 468 =pod
 469
 470 =head2 login
 471
 472 Performs a login on the remote host. Normally this is done during
 473 construction but this method allows you to login, say again, as maybe
 474 another user...
 475
 476 Parameters:
 477
 478 =for html <blockquote>
 479
 480 =over
 481
 482 =item None
 483
 484 =back
 485
 486 =for html </blockquote>
 487
 488 Returns:
 489
 490 =for html <blockquote>
 491
 492 =over
 493
 494 =item Nothing
 495
 496 =back
 497
 498 =for html </blockquote>
 499
 500 =cut
 501
 502   # Close any prior opened sessions
 503   $self->logoff if ($self->{handle});
 504
 505   # Check to see if this machines is known in DNS. If not then the chance is
 506   # good that we will not be able to log in
 507   return unless gethostbyname $self->{host};
 508
 509   my $remote;
 510
 511   if ($self->{protocol}) {
 512     if ($self->{protocol} eq "ssh") {
 513       return $self->ssh;
 514     } elsif ($self->{protocol} eq "rsh" or $self->{protocol} eq "rlogin") {
 515       return $self->rlogin;
 516     } elsif ($self->{protocol} eq "telnet") {
 517       return $self->telnet;
 518     } else {
 519       croak "ERROR: Invalid protocol $self->{protocol} specified", 1;
 520     } # if
 521   } else {
 522     return $remote if $remote = $self->ssh;
 523     return $remote if $remote = $self->rlogin;
 524     return $self->telnet;
 525   } # if
 526
 527   return;
 528 } # login
 529
 530 sub logoff {
 531   my ($self) = shift;
 532
 533 =pod
 534
 535 =head3 logoff
 536
 537 Performs a logout on the remote host. Normally handled in the
 538 destructor but you could call logout to logout if you wish.
 539
 540 Parameters:
 541
 542 =for html <blockquote>
 543
 544 =over
 545
 546 =item None
 547
 548 =back
 549
 550 =for html </blockquote>
 551
 552 Returns:
 553
 554 =for html <blockquote>
 555
 556 =over
 557
 558 =item Nothing
 559
 560 =back
 561
 562 =for html </blockquote>
 563
 564 =cut
 565
 566   $self->{handle}->soft_close;
 567
 568   undef $self->{handle};
 569   undef $self->{status};
 570   undef $self->{lines};
 571
 572   return;
 573 } # logoff
 574
 575 sub new {
 576   my ($class, %parms) = @_;
 577
 578 =pod
 579
 580 =head3 new (<parms>)
 581
 582 This method instantiates a new Rexec object. Currently only hash style
 583 parameter passing is supported.
 584
 585 Parameters:
 586
 587 =for html <blockquote>
 588
 589 =over
 590
 591 =item host => <host>:
 592
 593 Specifies the host to connect to. Default: localhost
 594
 595 =item username => <username>
 596
 597 Specifies the username to use if prompted. Default: No username specified.
 598
 599 =item password => <password>
 600
 601 Specifies the password to use if prompted. Default: No password
 602 specified. Note passwords must be in cleartext at this
 603 time. Specifying them makes you insecure!
 604
 605 =item prompt => <prompt regex>
 606
 607 Specifies a regex describing how to identify a prompt. Default:
 608 qr'[#>:$](\s*|\e.+)$'
 609
 610 =item protocol => <ssh|rsh|rlogin|telnet>
 611
 612 Specifies the protocol to use when connecting. Default: Try them all
 613 starting with ssh.
 614
 615 =item opts => <options>
 616
 617 Additional options for protocol (e.g. -X for ssh and X forwarding)
 618
 619 =item verbose => <0|1>
 620
 621 If true then status messages are echoed to stdout. Default: 0.
 622
 623 =back
 624
 625 =for html </blockquote>
 626
 627 Returns:
 628
 629 =for html <blockquote>
 630
 631 =over
 632
 633 =item Rexec object
 634
 635 =back
 636
 637 =for html </blockquote>
 638
 639 =cut
 640
 641   my $self = {};
 642
 643   $self->{host}       = $parms{host}       ? $parms{host}       : 'localhost';
 644   $self->{username}   = $parms{username};
 645   $self->{password}   = $parms{password};
 646   $self->{prompt}     = $parms{prompt}     ? $parms{prompt}     : $DEFAULT_PROMPT;
 647   $self->{protocol}   = $parms{protocol};
 648   $self->{verbose}    = $parms{verbose};
 649   $self->{shellstyle} = $parms{shellstyle} ? $parms{shellstyle} : 'sh';
 650   $self->{opts}       = $parms{opts}       ? $parms{opts}       : '';
 651   $self->{timeout}    = $parms{timeout}    ? $parms{timeout}    : $default_login_timeout;
 652
 653   if ($self->{shellstyle} ne 'sh' and $self->{shellstyle} ne 'csh') {
 654     croak 'ERROR: Unknown shell style specified. Must be one of "sh" or "csh"',
 655   } # if
 656
 657   bless ($self, $class);
 658
 659   # now login...
 660   $self->{handle} = $self->login;
 661
 662   # Set timeout to $default_exec_timeout
 663   $self->{timeout} = $default_exec_timeout;
 664
 665   return $self->{handle} ? $self : undef;
 666 } # new
 667
 668 sub execute ($$) {
 669   my ($self, $cmd, $timeout) = @_;
 670
 671 =pod
 672
 673 =head3 exec ($cmd, $timeout)
 674
 675 This method executes a command on the remote host returning an array
 676 of lines that the command produced, if any. Status of the command is
 677 stored in the object and accessible via the status method.
 678
 679 Parameters:
 680
 681 =for html <blockquote>
 682
 683 =over
 684
 685 =item $cmd:
 686
 687 Command to execute remotely
 688
 689 =item $timeout
 690
 691 Set timeout for this execution. If timeout is 0 then wait forever. If
 692 you wish to interrupt this then set up a signal handler.
 693
 694 =back
 695
 696 =for html </blockquote>
 697
 698 Returns:
 699
 700 =for html <blockquote>
 701
 702 =over
 703
 704 =item @lines
 705
 706 An array of lines from STDOUT of the command. If STDERR is also wanted
 707 then add STDERR redirection to $cmd. Exit status is not returned by
 708 retained in the object. Use status method to retrieve it.
 709
 710 =back
 711
 712 =for html </blockquote>
 713
 714 =cut
 715
 716   # If timeout is specified for this exec then use it - otherwise
 717   # use the object's defined timeout.
 718   $timeout = $timeout ? $timeout : $self->{timeout};
 719
 720   # If timeout is set to 0 then the user wants an indefinite
 721   # timeout. But Expect wants it to be undefined. So undef it if
 722   # it's 0. Note this means we do not support Expect's "check it
 723   # only one time" option.
 724   undef $timeout if $timeout == 0;
 725
 726   # If timeout is < 0 then the user wants to run the command in the
 727   # background and return. We still need to wait as we still may
 728   # timeout so change $timeout to the $default_exec_timeout in this
 729   # case and add a "&" to the command if it's not already there.
 730   # because the user has added a & to the command to run it in the
 731   if ($timeout && $timeout < 0) {
 732     $timeout = $default_exec_timeout;
 733     $cmd .= "&" if $cmd !~ /&$/;
 734   } # if
 735
 736   # Set status to -2 indicating nothing happened! We should never
 737   # return -2 (unless a command manages to set $? to -2!)
 738   $self->{status} = -2;
 739
 740   # Empty lines of any previous command output
 741   @lines = ();
 742
 743   # Hopefully we will not see the following in the output string
 744   my $errno_str = "ReXeCerRoNO=";
 745   my $start_str = "StaRT";
 746
 747   my $compound_cmd;
 748
 749   # If cmd ends in a & then it makes no sense to compose a compound
 750   # command. The original command will be in the background and thus
 751   # we should not attempt to get a status - there will be none.
 752   if ($cmd !~ /&$/) {
 753     $compound_cmd = "echo $start_str; $cmd; echo $errno_str";
 754     $compound_cmd .= $self->{shellstyle} eq "sh" ? "\$?" : "\$status";
 755   } else {
 756     $compound_cmd = $cmd;
 757   } # if
 758
 759   $self->{handle}->send ("$compound_cmd\n");
 760
 761   $self->{handle}->expect (
 762     $timeout,
 763
 764     [ timeout =>
 765       sub {
 766         $self->{status} = -1;
 767       }
 768     ],
 769
 770     [ qr "\n$start_str",
 771       sub {
 772         exp_continue;
 773       }
 774     ],
 775
 776     [ qr "\n$errno_str",
 777       sub {
 778         my ($exp) = @_;
 779
 780         my $before = $exp->before;
 781         my $after  = $exp->after;
 782
 783         if ($after =~ /(\d+)/) {
 784           $self->{status} = $1;
 785         } # if
 786
 787         my @output = split /\n/, $before;
 788
 789         chomp @output;
 790         chop @output if $output[0] =~ /\r$/;
 791
 792         foreach (@output) {
 793           next if /^$/;
 794           last if /$errno_str=/;
 795
 796           push @lines, $_;
 797         } # foreach
 798
 799         exp_continue;
 800       }
 801     ],
 802
 803     [ $self->{prompt},
 804       sub {
 805         print 'Hit prompt!' if $debug;
 806       }
 807     ],
 808   );
 809
 810   $self->{lines} = \@lines;
 811
 812   return @lines;
 813 } # exec
 814
 815 sub abortCmd (;$) {
 816   my ($self, $timeout) = @_;
 817
 818 =pod
 819
 820 =head3 abortCmd
 821
 822 Aborts the current command by sending a Control-C (assumed to be the
 823 interrupt character).
 824
 825 Parameters:
 826
 827 =for html <blockquote>
 828
 829 =over
 830
 831 =item None
 832
 833 =back
 834
 835 =for html </blockquote>
 836
 837 Returns:
 838
 839 =for html <blockquote>
 840
 841 =over
 842
 843 =item $status
 844
 845 1 if abort was successful (we got a command prompt back) or 0 if it
 846 was not.
 847
 848 =back
 849
 850 =for html </blockquote>
 851
 852 =cut
 853
 854   # If timeout is specified for this exec then use it - otherwise
 855   # use the object's defined timeout.
 856   $timeout = $timeout ? $timeout : $self->{timeout};
 857
 858   # If timeout is set to 0 then the user wants an indefinite
 859   # timeout. But Expect wants it to be undefined. So undef it if
 860   # it's 0. Note this means we do not support Expect's "check it
 861   # only one time" option.
 862   undef $timeout if $timeout == 0;
 863
 864   # Set status to -2 indicating nothing happened! We should never
 865   # return -2 (unless a command manages to set $? to -2!)
 866   $self->{status} = -2;
 867
 868   $self->{handle}->send ("\cC");
 869
 870   $self->{handle}->expect (
 871     $timeout,
 872
 873     [ timeout =>
 874       sub {
 875         $self->{status} = -1;
 876       }
 877     ],
 878
 879     [ $self->{prompt},
 880       sub {
 881         print "Hit prompt!" if $debug;
 882       }
 883     ],
 884   );
 885
 886   return $self->{status};
 887 } # abortCmd
 888
 889 sub status {
 890   my ($self) = @_;
 891
 892 =pod
 893
 894 =head3 status
 895
 896 Returns the status of the last command executed remotely.
 897
 898 Parameters:
 899
 900 =for html <blockquote>
 901
 902 =over
 903
 904 =item None
 905
 906 =back
 907
 908 =for html </blockquote>
 909
 910 Returns:
 911
 912 =for html <blockquote>
 913
 914 =over
 915
 916 =item $status
 917
 918 Last status from exec.
 919
 920 =back
 921
 922 =for html </blockquote>
 923
 924 =cut
 925
 926   return $self->{status};
 927 } # status
 928
 929 sub shellstyle {
 930   my ($self) = @_;
 931
 932 =pod
 933
 934 =head3 shellstyle
 935
 936 Returns the shellstyle
 937
 938 Parameters:
 939
 940 =for html <blockquote>
 941
 942 =over
 943
 944 =item None
 945
 946 =back
 947
 948 =for html </blockquote>
 949
 950 Returns:
 951
 952 =for html <blockquote>
 953
 954 =over
 955
 956 =item "sh"|"csh"
 957
 958 sh: Bourne or csh: for csh style shells
 959
 960 =back
 961
 962 =for html </blockquote>
 963
 964 =cut
 965
 966   return $self->{shellstyle};
 967 } # shellstyle
 968
 969 sub lines () {
 970   my ($self) = @_;
 971
 972 =pod
 973
 974 =head3 lines
 975
 976 Returns the lines array from the last command called by exec.
 977
 978 Parameters:
 979
 980 =for html <blockquote>
 981
 982 =over
 983
 984 =item None
 985
 986 =back
 987
 988 =for html </blockquote>
 989
 990 Returns:
 991
 992 =for html <blockquote>
 993
 994 =over
 995
 996 =item @lines
 997
 998 An array of lines from the last call to exec.
 999
1000 =back
1001
1002 =for html </blockquote>
1003
1004 =cut
1005
1006   return @{$self->{lines}};
1007 } # lines
1008
1009 sub print_lines () {
1010   my ($self) = @_;
1011
1012 =pod
1013
1014 =head3 print_lines
1015
1016 Essentially prints the lines array to stdout
1017
1018 Parameters:
1019
1020 =for html <blockquote>
1021
1022 =over
1023
1024 =item None
1025
1026 =back
1027
1028 =for html </blockquote>
1029
1030 Returns:
1031
1032 =for html <blockquote>
1033
1034 =over
1035
1036 =item Nothing
1037
1038 =back
1039
1040 =for html </blockquote>
1041
1042 =cut
1043
1044   print "$_\n" foreach ($self->lines);
1045
1046   return;
1047 } # print_lines
1048
1049 sub getHost () {
1050   my ($self) = @_;
1051
1052 =pod
1053
1054 =head3 host
1055
1056 Returns the host from the object.
1057
1058 Parameters:
1059
1060 =for html <blockquote>
1061
1062 =over
1063
1064 =item None
1065
1066 =back
1067
1068 =for html </blockquote>
1069
1070 Returns:
1071
1072 =for html <blockquote>
1073
1074 =over
1075
1076 =item $hostname
1077
1078 =back
1079
1080 =for html </blockquote>
1081
1082 =cut
1083
1084   return $self->{host};
1085 } # getHost
1086
1087 sub DESTROY {
1088   my ($self) = @_;
1089
1090   $self->{handle}->hard_close
1091     if $self->{handle};
1092
1093   return;
1094 } # destroy
1095
1096 sub getTimeout {
1097   my ($self) = @_;
1098
1099 =head3 getTimeout
1100
1101 Returns the timeout from the object.
1102
1103 Parameters:
1104
1105 =for html <blockquote>
1106
1107 =over
1108
1109 =item None
1110
1111 =back
1112
1113 =for html </blockquote>
1114
1115 Returns:
1116
1117 =for html <blockquote>
1118
1119 =over
1120
1121 =item $timeout
1122
1123 =back
1124
1125 =for html </blockquote>
1126
1127 =cut
1128
1129   return $self->{timeout} ? $self->{timeout} : $default_login_timeout;
1130 } # getTimeout
1131
1132 sub setTimeout ($) {
1133   my ($self, $timeout) = @_;
1134
1135 =pod
1136
1137 =head3 setTimeout ($timeout)
1138
1139 Sets the timeout value for subsequent execution.
1140
1141 Parameters:
1142
1143 =for html <blockquote>
1144
1145 =over
1146
1147 =item $timeout
1148
1149 New timeout value to set
1150
1151 =back
1152
1153 =for html </blockquote>
1154
1155 Returns:
1156
1157 =for html <blockquote>
1158
1159 =over
1160
1161 =item $timeout
1162
1163 Old timeout value
1164
1165 =back
1166
1167 =for html </blockquote>
1168
1169 =cut
1170
1171   my $oldTimeout = $self->getTimeout;
1172   $self->{timeout} = $timeout;
1173
1174   return $oldTimeout;
1175 } # setTimeout
1176
1177 1;
1178
1179 =head1 DIAGNOSTICS
1180
1181 =head2 Errors
1182
1183 If verbose is turned on then connections or failure to connect will be
1184 echoed to stdout.
1185
1186 =head3 Error text
1187
1188   <host> is not responding to <protocol>
1189   Connected to <host> using <protocol> protocol
1190   Unable to connect to <host> using <protocol> protocol
1191
1192 =head2 Warnings
1193
1194 Specifying cleartext passwords is not recommended for obvious security concerns.
1195
1196 =head1 CONFIGURATION AND ENVIRONMENT
1197
1198 Configuration files and environment variables.
1199
1200 =over
1201
1202 =item None
1203
1204 =back
1205
1206 =head1 DEPENDENCIES
1207
1208 =head2 Perl Modules
1209
1210 =for html <a href="http://search.cpan.org/~rgiersig/Expect-1.21/Expect.pod">Expect</a>
1211
1212 =head3 ClearSCM Perl Modules
1213
1214 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1215
1216 =head1 INCOMPATABILITIES
1217
1218 None yet...
1219
1220 =head1 BUGS AND LIMITATIONS
1221
1222 There are no known bugs in this module.
1223
1224 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1225
1226 =head1 LICENSE AND COPYRIGHT
1227
1228 This Perl Module is freely available; you can redistribute it and/or
1229 modify it under the terms of the GNU General Public License as
1230 published by the Free Software Foundation; either version 2 of the
1231 License, or (at your option) any later version.
1232
1233 This Perl Module is distributed in the hope that it will be useful,
1234 but WITHOUT ANY WARRANTY; without even the implied warranty of
1235 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1236 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
1237 details.
1238
1239 You should have received a copy of the GNU General Public License
1240 along with this Perl Module; if not, write to the Free Software Foundation,
1241 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1242 reserved.
1243
1244 =cut