Coro/Coro/Debug.pm

=head1 NAME

Coro::Debug - various functions that help debugging Coro programs

=head1 SYNOPSIS

 use Coro::Debug;

 our $server = new_server Coro::Debug path => "/tmp/socketpath";

 $ socat readline unix:/tmp/socketpath

=head1 DESCRIPTION

This module provides some debugging facilities. Most will, if not handled
carefully, severely compromise the security of your program, so use it
only for debugging (or take other precautions).

It mainly implements a very primitive debugger that lets you list running
coroutines:

   > ps
       pid RUND description where
   8024992 ----             [/localvol/root/src/Coro/blib/lib/Coro.pm:544]
   8024688 --N-             <unknown>
   8024512 ----             [/localvol/root/src/Coro/blib/lib/Coro/Event.pm:166]

Lets you do backtraces on about any coroutine:

   > bt 8024992
   coroutine is at at /localvol/root/src/Coro/blib/lib/Coro.pm line 544
   eval {...} called at /localvol/root/src/Coro/blib/lib/Coro.pm line 544
   Coro::__ANON__ called at x line 0
   Coro::_run_coro called at x line 0

Or lets you eval perl code:

   > p 5+7
   12

Or lets you eval perl code within other coroutines:

   > eval 8024512 $_
   1

=over 4

=cut

package Coro::Debug;

use strict;

use Carp ();
use IO::Socket::UNIX;
use AnyEvent;

use Coro ();
use Coro::Handle ();
use Coro::State ();

sub find_coro {
   my ($pid) = @_;
   if (my ($coro) = grep $_ == $1, Coro::State::list) {
      $coro
   } else {
      print "$pid: no such coroutine\n";
      undef
   }
}

=item command $string

Execute a debugger command, sending any output to STDOUT. Used by
C<session>, below.

=cut

sub command($) {
   my ($cmd) = @_;

   $cmd =~ s/[\012\015]$//;

   if ($cmd =~ /^ps/) {
      printf "%20s %s%s%s%s %4s %-20.20s %s\n", "pid", "R", "U", "N", "D", "RSS", "description", "where";
      for my $coro (Coro::State::list) {
         my @bt;
         $coro->_eval (sub { @bt = caller });
         printf "%20s %s%s%s%s %4d %-20.20s %s\n",
                $coro+0,
                $coro->is_ready     ? "R" : "-",
                $coro->is_running   ? "U" : "-",
                $coro->is_new       ? "N" : "-",
                $coro->is_destroyed ? "D" : "-",
                $coro->rss / 1024,
                $coro->debug_desc,
                (@bt ? sprintf "[%s:%d]", $bt[1], $bt[2] : "<unknown>");
      }

   } elsif ($cmd =~ /bt\s+(\d+)/) {
      if (my $coro = find_coro $1) {
         my $bt;
         $coro->_eval (sub { $bt = Carp::longmess "coroutine is at" });
         if ($bt) {
            print $bt;
         } else {
            print "$1: unable to get backtrace\n";
         }
      }

   } elsif ($cmd =~ /p\s+(.*)$/) {
      print $@ ? $@ : (join " ", (eval $1), "\n");

   } elsif ($cmd =~ /eval\s+(\d+)\s+(.*)$/) {
      if (my $coro = find_coro $1) {
         my $cmd = $2;
         my @res;
         $coro->_eval (sub { my @res = eval $cmd });
         print $@ ? $@ : (join " ", @res, "\n");
      }

   } elsif ($cmd =~ /^help/) {
      print <<EOF;
ps                      show the list of all coroutines
bt <pid>                show a full backtrace of coroutine <pid>
p <perl>                evaluate <perl> expression and print results
eval <pid> <perl>       evaluate <perl> expression in context of <pid> (dangerous!)
exit                    end this session

EOF

   } else {
      print "$cmd: unknown command\n";
   }
}

=item session $fh

Run an interactive debugger session on the given filehandle. Each line entered
is simply passed to C<command>

=cut

sub session($) {
   my ($fh) = @_;

   $fh = Coro::Handle::unblock $fh;
   select $fh;

   print "coro debug session. use help for more info\n\n";

   while ((print "> "), defined (my $cmd = $fh->readline ("\012"))) {
      if ($cmd =~ /^exit/) {
         print "bye.\n";
         last;
      }

      command $cmd;
   }
}

=item $server = new_unix_server Coro::Debug $path

Creates a new unix domain socket that listens for connection requests and
runs C<session> on any connection. Normal unix permission checks and umask
applies, so you can protect your socket by puttint it into a protected
directory.

The C<socat> utility is an excellent way to connect to this socket,
offering readline and history support:

   socat readline:history=/tmp/hist.corodebug unix:/path/to/socket

The server accepts connections until it is destroyed, so you should keep
the return value around as long as you want the server to stay available.

=cut

sub new_unix_server {
   my ($class, $path) = @_;

   unlink $path;
   my $fh = new IO::Socket::UNIX Listen => 1, Local => $path
      or Carp::croak "Coro::Debug::Server($path): $!";

   my $self = bless {
      fh   => $fh,
      path => $path,
   }, $class;

   $self->{cw} = AnyEvent->io (fh => $fh, poll => 'r', cb => sub {
      Coro::async_pool {
         $Coro::current->desc ("Coro::Debug server");
         my $fh = $fh->accept;
         session $fh;
         close $fh;
      };
   });

   $self
}

sub DESTROY {
   my ($self) = @_;

   unlink $self->{path};
   close $self->{fh};
   %$self = ();
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut


Revision:	1.5
Committed:	Thu Sep 20 12:19:39 2007 UTC (16 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.4:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			Coro::Debug - various functions that help debugging Coro programs
4
5			=head1 SYNOPSIS
6
7			use Coro::Debug;
8
9			our $server = new_server Coro::Debug path => "/tmp/socketpath";
10
11			$ socat readline unix:/tmp/socketpath
12
13			=head1 DESCRIPTION
14
15			This module provides some debugging facilities. Most will, if not handled
16			carefully, severely compromise the security of your program, so use it
17			only for debugging (or take other precautions).
18
19			It mainly implements a very primitive debugger that lets you list running
20			coroutines:
21
22			> ps
23			pid RUND description where
24			8024992 ---- [/localvol/root/src/Coro/blib/lib/Coro.pm:544]
25			8024688 --N- <unknown>
26			8024512 ---- [/localvol/root/src/Coro/blib/lib/Coro/Event.pm:166]
27
28			Lets you do backtraces on about any coroutine:
29
30			> bt 8024992
31			coroutine is at at /localvol/root/src/Coro/blib/lib/Coro.pm line 544
32			eval {...} called at /localvol/root/src/Coro/blib/lib/Coro.pm line 544
33			Coro::__ANON__ called at x line 0
34			Coro::_run_coro called at x line 0
35
36			Or lets you eval perl code:
37
38			> p 5+7
39			12
40
41			Or lets you eval perl code within other coroutines:
42
43			> eval 8024512 $_
44			1
45
46			=over 4
47
48			=cut
49
50			package Coro::Debug;
51
52			use strict;
53
54			use Carp ();
55			use IO::Socket::UNIX;
56			use AnyEvent;
57
58	root	1.3	use Coro ();
59			use Coro::Handle ();
60			use Coro::State ();
61	root	1.1
62			sub find_coro {
63			my ($pid) = @_;
64			if (my ($coro) = grep $_ == $1, Coro::State::list) {
65			$coro
66			} else {
67			print "$pid: no such coroutine\n";
68			undef
69			}
70			}
71
72			=item command $string
73
74			Execute a debugger command, sending any output to STDOUT. Used by
75			C<session>, below.
76
77			=cut
78
79			sub command($) {
80			my ($cmd) = @_;
81
82			$cmd =~ s/[\012\015]$//;
83
84			if ($cmd =~ /^ps/) {
85	root	1.4	printf "%20s %s%s%s%s %4s %-20.20s %s\n", "pid", "R", "U", "N", "D", "RSS", "description", "where";
86	root	1.3	for my $coro (Coro::State::list) {
87	root	1.1	my @bt;
88			$coro->_eval (sub { @bt = caller });
89	root	1.4	printf "%20s %s%s%s%s %4d %-20.20s %s\n",
90	root	1.1	$coro+0,
91			$coro->is_ready ? "R" : "-",
92			$coro->is_running ? "U" : "-",
93			$coro->is_new ? "N" : "-",
94			$coro->is_destroyed ? "D" : "-",
95	root	1.4	$coro->rss / 1024,
96	root	1.1	$coro->debug_desc,
97			(@bt ? sprintf "[%s:%d]", $bt[1], $bt[2] : "<unknown>");
98			}
99
100			} elsif ($cmd =~ /bt\s+(\d+)/) {
101			if (my $coro = find_coro $1) {
102			my $bt;
103			$coro->_eval (sub { $bt = Carp::longmess "coroutine is at" });
104			if ($bt) {
105			print $bt;
106			} else {
107			print "$1: unable to get backtrace\n";
108			}
109			}
110
111			} elsif ($cmd =~ /p\s+(.*)$/) {
112			print $@ ? $@ : (join " ", (eval $1), "\n");
113
114			} elsif ($cmd =~ /eval\s+(\d+)\s+(.*)$/) {
115			if (my $coro = find_coro $1) {
116			my $cmd = $2;
117			my @res;
118			$coro->_eval (sub { my @res = eval $cmd });
119			print $@ ? $@ : (join " ", @res, "\n");
120			}
121
122			} elsif ($cmd =~ /^help/) {
123			print <<EOF;
124			ps show the list of all coroutines
125			bt <pid> show a full backtrace of coroutine <pid>
126			p <perl> evaluate <perl> expression and print results
127			eval <pid> <perl> evaluate <perl> expression in context of <pid> (dangerous!)
128			exit end this session
129
130			EOF
131
132			} else {
133			print "$cmd: unknown command\n";
134			}
135			}
136
137			=item session $fh
138
139			Run an interactive debugger session on the given filehandle. Each line entered
140			is simply passed to C<command>
141
142			=cut
143
144			sub session($) {
145			my ($fh) = @_;
146
147			$fh = Coro::Handle::unblock $fh;
148			select $fh;
149
150			print "coro debug session. use help for more info\n\n";
151
152			while ((print "> "), defined (my $cmd = $fh->readline ("\012"))) {
153			if ($cmd =~ /^exit/) {
154			print "bye.\n";
155			last;
156			}
157
158			command $cmd;
159			}
160			}
161
162			=item $server = new_unix_server Coro::Debug $path
163
164			Creates a new unix domain socket that listens for connection requests and
165			runs C<session> on any connection. Normal unix permission checks and umask
166			applies, so you can protect your socket by puttint it into a protected
167			directory.
168
169			The C<socat> utility is an excellent way to connect to this socket,
170			offering readline and history support:
171
172			socat readline:history=/tmp/hist.corodebug unix:/path/to/socket
173
174			The server accepts connections until it is destroyed, so you should keep
175			the return value around as long as you want the server to stay available.
176
177			=cut
178
179			sub new_unix_server {
180			my ($class, $path) = @_;
181
182			unlink $path;
183			my $fh = new IO::Socket::UNIX Listen => 1, Local => $path
184			or Carp::croak "Coro::Debug::Server($path): $!";
185
186			my $self = bless {
187			fh => $fh,
188			path => $path,
189			}, $class;
190
191	root	1.3	$self->{cw} = AnyEvent->io (fh => $fh, poll => 'r', cb => sub {
192			Coro::async_pool {
193	root	1.5	$Coro::current->desc ("Coro::Debug server");
194	root	1.3	my $fh = $fh->accept;
195			session $fh;
196			close $fh;
197			};
198	root	1.1	});
199
200			$self
201			}
202
203			sub DESTROY {
204			my ($self) = @_;
205
206			unlink $self->{path};
207			close $self->{fh};
208			%$self = ();
209			}
210
211			1;
212
213			=back
214
215			=head1 AUTHOR
216
217			Marc Lehmann <schmorp@schmorp.de>
218			http://home.schmorp.de/
219
220			=cut
221
222