summaryrefslogtreecommitdiff
path: root/DB.pm
blob: fee6e460453a9fb425f7b1f9f79f7e9d20d8f49d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
package Apache::DB;

use 5.005;
use strict;
use DynaLoader ();

BEGIN { 
	use constant MP2 => eval { 
        exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2
    };
	die "mod_perl is required to run this module: $@" if $@; 

	if (MP2) { 
		require APR::Pool;
		require Apache2::RequestRec;
	}
}

{
    no strict;
    @ISA = qw(DynaLoader);
    $VERSION = '0.16';
    __PACKAGE__->bootstrap($VERSION);
}

$Apache::Registry::MarkLine = 0;

sub init {
    if(init_debugger()) {
	warn "[notice] Apache::DB initialized in child $$\n";
    }

    1;
}

sub handler {
    my $r = shift;

    init();

    {
       local $@;
       my $loaded_db;

       if ($ENV{PERL5DB}) {
           (my $directive = $ENV{PERL5DB}) 
		   		=~ s/^\s*BEGIN\s*{\s*(.*)\s*}\z/$1/s;
           $directive =~ s/^require\b/do/;
           $loaded_db = eval($directive);
       }

       if (!$loaded_db) {
           # Fallback
           require 'Apache/perl5db.pl';
       }
    }

    $DB::single = 1;

	if( MP2 ) { 
		if (ref $r) {
		$SIG{INT} = \&DB::catch;
		$r->pool->cleanup_register(sub { 
			$SIG{INT} = \&DB::ApacheSIGINT();
		});
		}
	}
	else {  
		if (ref $r) {
		$SIG{INT} = \&DB::catch;
		$r->register_cleanup(sub { 
			$SIG{INT} = \&DB::ApacheSIGINT();
		});
		}
	}

    return 0;
}

1;
__END__

=head1 NAME

Apache::DB - Run the interactive Perl debugger under mod_perl

=head1 SYNOPSIS

 <Location /perl>
  PerlFixupHandler +Apache::DB

  SetHandler perl-script
  PerlHandler +Apache::Registry
  Options +ExecCGI
 </Location>

=head1 DESCRIPTION

Perl ships with a very useful interactive debugger, however, it does not run
"out-of-the-box" in the Apache/mod_perl environment.  Apache::DB makes a few
adjustments so the two will cooperate.

=head1 FUNCTIONS

=over 4

=item init

This function initializes the Perl debugger hooks without actually
starting the interactive debugger.  In order to debug a certain piece
of code, this function must be called before the code you wish debug
is compiled.  For example, if you want to insert debugging symbols
into code that is compiled at server startup, but do not care to debug
until request time, call this function from a PerlRequire'd file:

 #where db.pl is simply:
 # use Apache::DB ();
 # Apache::DB->init;
 PerlRequire conf/db.pl

 #where modules are loaded
 PerlRequire conf/init.pl

If you are using mod_perl 2.0 you will need to use the following 
as your db.pl: 

  use APR::Pool (); 
  use Apache::DB (); 
  Apache::DB->init(); 

=item handler

This function will start the interactive debugger.  It will invoke
I<Apache::DB::init> if needed.  Example configuration:

 <Location /my-handler>
  PerlFixupHandler Apache::DB
  SetHandler perl-script
  PerlHandler My::handler
 </Location>

=back

=head1 SELinux

Security-enhanced Linux (SELinux) is a mandatory access control system
many linux distrobutions are implementing.  This new security scheme
can assist you with protecting a server, but it doesn't come without
its own set of issues.  Debugging applications running on a box with
SELinux on it takes a couple of extra steps and unfortunately the
instructions that follow have only been tested on RedHat/Fedora.

1) You need to edit/create the file "local.te" and add the following:

if (httpd_tty_comm) {
    allow { httpd_t } admin_tty_type:chr_file { ioctl getattr }; }

2) Reload your security policy.

3) Run the command "setsebool httpd_tty_comm true".

You should be aware as you debug applications on a system with SELinux
your code may very well be correct, but the system policy is denying your
actions.  

=head1 CAVEATS

=over 4

=item -X

The server must be started with the C<-X> to use Apache::DB.

=item filename/line info

The filename of Apache::Registry scripts is not displayed.

=back

=head1 SEE ALSO

perldebug(1)

=head1 AUTHOR

Originally written by Doug MacEachern

Currently maintained by Dirk Lindner <lze@cpan.org>


=head1 LICENSE 

This module is distributed under the same terms as Perl itself.