File: runtime.pm

package info (click to toggle)
libapache2-mod-perl2 2.0.9~1624218-2%2Bdeb8u2
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 11,912 kB
  • ctags: 4,588
  • sloc: perl: 95,064; ansic: 14,527; makefile: 49; sh: 18
file content (162 lines) | stat: -rw-r--r-- 3,739 bytes parent folder | download | duplicates (7)
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
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestError::runtime;

use strict;
use warnings FATAL => 'all';

use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Connection ();
use APR::Socket ();
use APR::Status ();

use Apache::TestUtil;

use Apache2::Const -compile => qw(OK);
use APR::Const     -compile => qw(EACCES);

use constant SIZE => 2048;

sub handler {
    my $r = shift;
    my $socket = $r->connection->client_socket;
    my $args = $r->args;

    $r->content_type('text/plain');

    # set timeout to 0 to make sure that any socket read call will
    # fail
    $socket->timeout_set(0);

    no strict 'refs';
    $args->($r, $socket);

    return Apache2::Const::OK;
}

sub overload_test {
    my ($r, $socket) = @_;

    eval { mp_error($socket) };

    die "there should have been an exception" unless $@;

    die "the exception should have been an APR::Error object"
        unless ref $@ eq 'APR::Error';

    # == && != (expecting an EAGAIN error)
    die "APR::Status is broken"   unless APR::Status::is_EAGAIN($@);
    die "'==' overload is broken" unless $@ == $@;
    die "'!=' overload is broken" unless $@ != APR::Const::EACCES;
    die "'!=' overload is broken" unless APR::Const::EACCES != $@;
    die "'!=' overload is broken" if     $@ != $@;

    # XXX: add more overload tests

    $r->print("ok overload_test");

}

sub plain_mp_error {
    my ($r, $socket) = @_;
    t_server_log_error_is_expected();
    mp_error($socket);
}

sub plain_non_mp_error {
    my ($r, $socket) = @_;
    t_server_log_error_is_expected();
    non_mp_error($socket);
}

sub die_hook_confess_mp_error {
    my ($r, $socket) = @_;
    local $SIG{__DIE__} = \&APR::Error::confess;
    t_server_log_error_is_expected();
    mp_error($socket);
}

sub die_hook_confess_non_mp_error {
    my ($r, $socket) = @_;
    local $SIG{__DIE__} = \&APR::Error::confess;
    t_server_log_error_is_expected();
    non_mp_error($socket);
}

sub die_hook_custom_mp_error {
    my ($r, $socket) = @_;
    local $SIG{__DIE__} = sub { die "custom die hook: $_[0]" };
    t_server_log_error_is_expected();
    mp_error($socket);
}

sub die_hook_custom_non_mp_error {
    my ($r, $socket) = @_;
    local $SIG{__DIE__} = sub { die "custom die hook: $_[0]" };
    t_server_log_error_is_expected();
    non_mp_error($socket);
}

sub eval_block_mp_error {
    my ($r, $socket) = @_;

    # throw in some retry attempts
    my $tries = 0;
    RETRY: eval { mp_error($socket) };
    if ($@ && ref($@) && APR::Status::is_EAGAIN($@)) {
        if ($tries++ < 3) {
            goto RETRY;
        }
        else {
            $r->print("ok eval_block_mp_error");
        }
    }
    else {
        die "eval block has failed: $@";
    }
}

sub eval_string_mp_error {
    my ($r, $socket) = @_;
    eval '$socket->recv(my $buffer, SIZE)';
    if ($@ && ref($@) && APR::Status::is_EAGAIN($@)) {
        $r->print("ok eval_string_mp_error");
    }
    else {
        die "eval string has failed: $@";
    }
}

sub eval_block_non_mp_error {
    my ($r, $socket) = @_;
    eval { non_mp_error($socket) };
    if ($@ && !ref($@)) {
        $r->print("ok eval_block_non_mp_error");
    }
    else {
        die "eval eval_non_mp_error has failed: $@";
    }
}

sub eval_block_non_error {
    my ($r, $socket) = @_;
    eval { 1; };
    if ($@) {
        die "eval eval_block_non_mp_error has failed";
    }
    $r->print("ok eval_block_non_error");
}

sub non_mp_error {
    no_such_func();
}

# fails because of the timeout set earlier in the handler
sub mp_error {
    my $socket = shift;
    $socket->recv(my $buffer, SIZE);
}

1;
__END__