line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package SRS::EPP::Proxy::UA; |
3
|
|
|
|
|
|
|
|
4
|
2
|
|
|
2
|
|
2024
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
use MooseX::Method::Signatures; |
6
|
|
|
|
|
|
|
use LWP::UserAgent; |
7
|
|
|
|
|
|
|
use Net::SSLeay::OO; |
8
|
|
|
|
|
|
|
use Moose::Util::TypeConstraints; |
9
|
|
|
|
|
|
|
use IO::Handle; |
10
|
|
|
|
|
|
|
use Storable qw(store_fd retrieve_fd); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
with 'MooseX::Log::Log4perl::Easy'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
enum __PACKAGE__."::states" => qw(waiting busy ready); |
15
|
|
|
|
|
|
|
BEGIN { |
16
|
|
|
|
|
|
|
class_type "HTTP::Request"; |
17
|
|
|
|
|
|
|
class_type "HTTP::Response"; |
18
|
|
|
|
|
|
|
class_type "IO::Handle"; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
has 'write_fh' => |
22
|
|
|
|
|
|
|
is => "rw", |
23
|
|
|
|
|
|
|
isa => "IO::Handle|GlobRef", |
24
|
|
|
|
|
|
|
; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
has 'read_fh' => |
27
|
|
|
|
|
|
|
is => "rw", |
28
|
|
|
|
|
|
|
isa => "IO::Handle|GlobRef", |
29
|
|
|
|
|
|
|
; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
has 'pid' => |
32
|
|
|
|
|
|
|
is => "rw", |
33
|
|
|
|
|
|
|
isa => "Int", |
34
|
|
|
|
|
|
|
; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
has 'state' => |
37
|
|
|
|
|
|
|
is => "rw", |
38
|
|
|
|
|
|
|
isa => __PACKAGE__."::states", |
39
|
|
|
|
|
|
|
default => "waiting", |
40
|
|
|
|
|
|
|
; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
method busy() { |
43
|
|
|
|
|
|
|
$self->state eq "busy"; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
method ready() { |
47
|
|
|
|
|
|
|
if ( $self->busy ) { |
48
|
|
|
|
|
|
|
$self->check_reader_ready; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
$self->state eq "ready"; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
method waiting() { |
53
|
|
|
|
|
|
|
$self->state eq "waiting"; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
method check_reader_ready( Num $timeout = 0 ) { |
57
|
|
|
|
|
|
|
my $fh = $self->read_fh; |
58
|
|
|
|
|
|
|
my $rin = ''; |
59
|
|
|
|
|
|
|
vec($rin, fileno($fh), 1) = 1; |
60
|
|
|
|
|
|
|
my $win = ''; |
61
|
|
|
|
|
|
|
my $ein = $rin; |
62
|
|
|
|
|
|
|
my ($nfound) = select($rin, $win, $ein, $timeout); |
63
|
|
|
|
|
|
|
if ( $nfound ) { |
64
|
|
|
|
|
|
|
if ( vec($ein, fileno($fh), 1) ) { |
65
|
|
|
|
|
|
|
die "reader handle in error state"; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
elsif ( vec($rin, fileno($fh), 1) ) { |
68
|
|
|
|
|
|
|
$self->state("ready"); |
69
|
|
|
|
|
|
|
return 1; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
|
|
|
|
|
|
die "??"; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
else { |
76
|
|
|
|
|
|
|
return; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub BUILD { |
81
|
|
|
|
|
|
|
my $self = shift; |
82
|
|
|
|
|
|
|
{ |
83
|
|
|
|
|
|
|
$self->log_trace("setting up pipes..."); |
84
|
|
|
|
|
|
|
pipe(my $rq_rdr, my $rq_wtr); |
85
|
|
|
|
|
|
|
pipe(my $rs_rdr, my $rs_wtr); |
86
|
|
|
|
|
|
|
$self->log_trace("forking..."); |
87
|
|
|
|
|
|
|
my $pid = fork; |
88
|
|
|
|
|
|
|
defined $pid or die "fork failed; $!"; |
89
|
|
|
|
|
|
|
if ( $pid ) { |
90
|
|
|
|
|
|
|
$self->log_trace( |
91
|
|
|
|
|
|
|
"parent, child pid = $pid, reading from ".fileno($rs_rdr) |
92
|
|
|
|
|
|
|
.", writing to ".fileno($rq_wtr) |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
$self->pid($pid); |
95
|
|
|
|
|
|
|
$self->read_fh($rs_rdr); |
96
|
|
|
|
|
|
|
$self->write_fh($rq_wtr); |
97
|
|
|
|
|
|
|
return; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
else { |
100
|
|
|
|
|
|
|
$self->log_trace( |
101
|
|
|
|
|
|
|
"child, I am $$, reading from " |
102
|
|
|
|
|
|
|
.fileno($rq_rdr).", writing to ".fileno($rs_wtr) |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
$0 = __PACKAGE__; |
105
|
|
|
|
|
|
|
$self->read_fh($rq_rdr); |
106
|
|
|
|
|
|
|
$self->write_fh($rs_wtr); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
$self->loop; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub DESTROY { |
113
|
|
|
|
|
|
|
my $self = shift; |
114
|
|
|
|
|
|
|
if (my $pid = $self->pid) { |
115
|
|
|
|
|
|
|
kill 15, $pid; |
116
|
|
|
|
|
|
|
waitpid($pid,0); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
use Storable qw(fd_retrieve store_fd); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
has 'ua' => |
123
|
|
|
|
|
|
|
is => "ro", |
124
|
|
|
|
|
|
|
isa => "LWP::UserAgent", |
125
|
|
|
|
|
|
|
lazy => 1, |
126
|
|
|
|
|
|
|
default => sub { |
127
|
|
|
|
|
|
|
LWP::UserAgent->new( |
128
|
|
|
|
|
|
|
agent => __PACKAGE__, |
129
|
|
|
|
|
|
|
timeout => 30, # 'fast' timeout for EPP sessions |
130
|
|
|
|
|
|
|
) |
131
|
|
|
|
|
|
|
}; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
method loop() { |
134
|
|
|
|
|
|
|
$SIG{TERM} = sub { exit(0) }; |
135
|
|
|
|
|
|
|
while ( 1 ) { |
136
|
|
|
|
|
|
|
$self->log_trace("UA waiting for request"); |
137
|
|
|
|
|
|
|
$0 = __PACKAGE__." - idle"; |
138
|
|
|
|
|
|
|
my $request = eval { fd_retrieve($self->read_fh) } |
139
|
|
|
|
|
|
|
or do { |
140
|
|
|
|
|
|
|
#$self->log_error("failed to read request; $@"); |
141
|
|
|
|
|
|
|
last; |
142
|
|
|
|
|
|
|
}; |
143
|
|
|
|
|
|
|
$self->log_debug("sending a request to back-end"); |
144
|
|
|
|
|
|
|
$0 = __PACKAGE__." - active"; |
145
|
|
|
|
|
|
|
my $response = $self->ua->request($request); |
146
|
|
|
|
|
|
|
$self->log_debug("got response - writing to response socket"); |
147
|
|
|
|
|
|
|
$0 = __PACKAGE__." - responding"; |
148
|
|
|
|
|
|
|
store_fd $response, $self->write_fh; |
149
|
|
|
|
|
|
|
$self->write_fh->flush; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
$self->log_trace("UA exiting"); |
152
|
|
|
|
|
|
|
exit(0); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
method request( HTTP::Request $request ) { |
156
|
|
|
|
|
|
|
die "sorry, can't handle a request in state '".$self->state."'" |
157
|
|
|
|
|
|
|
unless $self->waiting; |
158
|
|
|
|
|
|
|
$self->log_trace("writing request to child UA socket"); |
159
|
|
|
|
|
|
|
store_fd $request, $self->write_fh; |
160
|
|
|
|
|
|
|
$self->write_fh->flush; |
161
|
|
|
|
|
|
|
$self->log_trace("flushed"); |
162
|
|
|
|
|
|
|
$self->state("busy"); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
method get_response() { |
166
|
|
|
|
|
|
|
die "sorry, not ready yet" unless $self->ready; |
167
|
|
|
|
|
|
|
my $response = retrieve_fd($self->read_fh); |
168
|
|
|
|
|
|
|
$self->state("waiting"); |
169
|
|
|
|
|
|
|
return $response; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
1; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
__END__ |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head1 NAME |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
SRS::EPP::Proxy::UA - subprocess-based UserAgent |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head1 SYNOPSIS |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my $ua = SRS::EPP::Proxy::UA->new; # creates sub-process. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
$ua->request($req); # off it goes! |
185
|
|
|
|
|
|
|
print "yes" if $ua->busy; # it's busy! |
186
|
|
|
|
|
|
|
sleep 1 until $ua->ready; # do other stuff |
187
|
|
|
|
|
|
|
my $response = $ua->get_response; |
188
|
|
|
|
|
|
|
print "yes" if $ua->waiting; # it's waiting for you! |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head1 DESCRIPTION |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
This class provides non-blocking UserAgent behaviour, by using a slave |
193
|
|
|
|
|
|
|
sub-process to call all the blocking L<LWP::UserAgent> functions to do |
194
|
|
|
|
|
|
|
the retrieval. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
This is done because the L<SRS::EPP::Session> class is designed to be |
197
|
|
|
|
|
|
|
a non-blocking system. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head1 SEE ALSO |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
L<LWP::UserAgent>, L<SRS::EPP::Session> |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head1 AUTHOR AND LICENCE |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Development commissioned by NZ Registry Services, and carried out by |
206
|
|
|
|
|
|
|
Catalyst IT - L<http://www.catalyst.net.nz/> |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Copyright 2009, 2010, NZ Registry Services. This module is licensed |
209
|
|
|
|
|
|
|
under the Artistic License v2.0, which permits relicensing under other |
210
|
|
|
|
|
|
|
Free Software licenses. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=cut |