rudimentary support for remote debugging, from aeons ago (somewhat

modified)
	Message-ID: <35FAB38F.EA9AAC50@activestate.com>
	Subject: Re: Patches to perl5db.pl to allow for remote debugging

p4raw-id: //depot/perl@4601

1 files changed, 50 insertions, 16 deletions

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 2314bf7c3d..b71e539363 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$VERSION = 1.0403;
+$VERSION = 1.04041;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -76,6 +76,8 @@ $header = "perl5db.pl version $VERSION";
 # LineInfo - file or pipe to print line number info to.  If it is a
 # pipe, a short "emacs like" message is used.
 #
+# RemotePort - host:port to connect to on remote host for remote debugging.
+#
 # Example $rcfile: (delete leading hashes!)
 #
 # &parse_options("NonStop=1 LineInfo=db.out");
@@ -179,7 +181,8 @@ $inhibit_exit = $option{PrintRet} = 1;
 		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
 		  recallCommand ShellBang pager tkRunning ornaments
 		  signalLevel warnLevel dieLevel inhibit_exit
-		  ImmediateStop bareStringify);
+		  ImmediateStop bareStringify
+		  RemotePort);
 
 %optionVars    = (
 		 hashDepth	=> \$dumpvar::hashDepth,
@@ -197,6 +200,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		 inhibit_exit   => \$inhibit_exit,
 		 maxTraceLen	=> \$maxtrace,
 		 ImmediateStop	=> \$ImmediateStop,
+		 RemotePort	=> \$remoteport,
 );
 
 %optionAction  = (
@@ -216,6 +220,7 @@ $inhibit_exit = $option{PrintRet} = 1;
 		  dieLevel	=> \&dieLevel,
 		  tkRunning	=> \&tkRunning,
 		  ornaments	=> \&ornaments,
+		  RemotePort	=> \&RemotePort,
 		 );
 
 %optionRequire = (
@@ -322,19 +327,30 @@ if ($notty) {
 
   $console = $tty if defined $tty;
 
-  if (defined $console) {
-    open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
-    open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
-      || open(OUT,">&STDOUT");	# so we don't dongle stdout
-  } else {
-    open(IN,"<&STDIN");
-    open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
-    $console = 'STDIN/OUT';
+  if (defined $remoteport) {
+    require IO::Socket;
+    $OUT = new IO::Socket::INET( Timeout  => '10',
+                                 PeerAddr => $remoteport,
+                                 Proto    => 'tcp',
+                               );
+    if (!$OUT) { die "Could not create socket to connect to remote host."; }
+    $IN = $OUT;
   }
-  # so open("|more") can read from STDOUT and so we don't dingle stdin
-  $IN = \*IN;
+  else {
+    if (defined $console) {
+      open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
+      open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
+        || open(OUT,">&STDOUT");	# so we don't dongle stdout
+    } else {
+      open(IN,"<&STDIN");
+      open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
+      $console = 'STDIN/OUT';
+    }
+    # so open("|more") can read from STDOUT and so we don't dingle stdin
+    $IN = \*IN;
 
-  $OUT = \*OUT;
+    $OUT = \*OUT;
+  }
   select($OUT);
   $| = 1;			# for DB::OUT
   select(STDOUT);
@@ -434,7 +450,7 @@ Debugged program terminated.  Use B<q> to quit or B<R> to restart,
   B<h q>, B<h R> or B<h O> to get additional info.  
 EOP
 	  $package = 'main';
-	  $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+	  $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
 	    "package $package;";	# this won't let them modify, alas
 	} else {
 	    $sub =~ s/\'/::/;
@@ -1525,7 +1541,15 @@ sub readline {
   }
   local $frame = 0;
   local $doret = -2;
-  $term->readline(@_);
+  if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
+    print $OUT @_;
+    my $stuff;
+    $IN->recv( $stuff, 2048 );
+    $stuff;
+  }
+  else {
+    $term->readline(@_);
+  }
 }
 
 sub dump_option {
@@ -1673,6 +1697,14 @@ sub ReadLine {
     $rl;
 }
 
+sub RemotePort {
+    if ($term) {
+        &warn("Too late to set RemotePort, enabled on next 'R'!\n") if @_;
+    }
+    $remoteport = shift if @_;
+    $remoteport;
+}
+
 sub tkRunning {
     if ($ {$term->Features}{tkRunning}) {
         return $term->tkRunning(@_);
@@ -1823,6 +1855,7 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
     I<signalLevel> I<warnLevel> I<dieLevel>:	level of verbosity;
     I<inhibit_exit>		Allows stepping off the end of the script.
     I<ImmediateStop>		Debugger should stop as early as possible.
+    I<RemotePort>:		Remote hostname:port for remote debugging
   The following options affect what happens with B<V>, B<X>, and B<x> commands:
     I<arrayDepth>, I<hashDepth>:	print only first N elements ('' for all);
     I<compactDump>, I<veryCompact>:	change style of array and hash dump;
@@ -1839,7 +1872,8 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
 	 I<ornaments> affects screen appearance of the command line.
 		During startup options are initialized from \$ENV{PERLDB_OPTS}.
 		You can put additional initialization options I<TTY>, I<noTTY>,
-		I<ReadLine>, and I<NonStop> there (or use `B<R>' after you set them).
+		I<ReadLine>, I<NonStop>, and I<RemotePort> there (or use
+		`B<R>' after you set them).
 B<<> I<expr>		Define Perl command to run before each prompt.
 B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
 B<>> I<expr>		Define Perl command to run after each prompt.