Percona Toolkit moved to https://jira.percona.com/projects/PT

Merge lp:~percona-toolkit-dev/percona-toolkit/tweak-httpmicro-tests into lp:percona-toolkit/2.1

  1. tweak-httpmicro-tests
  2. Merge into 2.1
Proposed by Daniel Nichter
Status: Rejected
Rejected by: Daniel Nichter
Proposed branch: lp:~percona-toolkit-dev/percona-toolkit/tweak-httpmicro-tests
Merge into: lp:percona-toolkit/2.1
Diff against target: 905 lines (+345/-111)
21 files modified
bin/pt-archiver (+7/-5)
bin/pt-config-diff (+7/-5)
bin/pt-deadlock-logger (+7/-5)
bin/pt-diskstats (+7/-5)
bin/pt-duplicate-key-checker (+7/-5)
bin/pt-find (+7/-5)
bin/pt-fk-error-logger (+7/-5)
bin/pt-heartbeat (+7/-5)
bin/pt-index-usage (+7/-5)
bin/pt-kill (+7/-5)
bin/pt-online-schema-change (+7/-5)
bin/pt-query-advisor (+7/-5)
bin/pt-query-digest (+7/-5)
bin/pt-slave-delay (+7/-5)
bin/pt-slave-restart (+7/-5)
bin/pt-table-checksum (+7/-5)
bin/pt-table-sync (+193/-10)
bin/pt-upgrade (+7/-5)
bin/pt-variable-advisor (+7/-5)
lib/HTTPMicro.pm (+7/-5)
t/lib/HTTPMicro.t (+19/-6)
To merge this branch: bzr merge lp:~percona-toolkit-dev/percona-toolkit/tweak-httpmicro-tests
Reviewer Review Type Date Requested Status
Daniel Nichter Disapprove
Review via email: mp+128364@code.launchpad.net
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) wrote :

Not really needed. Only http://bazaar.launchpad.net/~percona-toolkit-dev/percona-toolkit/2.1/revision/406 was really needed.

review: Disapprove

Unmerged revisions

406. By Daniel Nichter

Update Pingback in pt-table-sync.

405. By Daniel Nichter

Update HTTPMicro in all tools.

404. By Daniel Nichter

Simplify check for IO::Socket::SSL. Give HTTPMicro tests unique names.

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1=== modified file 'bin/pt-archiver'
2--- bin/pt-archiver 2012-09-24 19:24:36 +0000
3+++ bin/pt-archiver 2012-10-06 19:35:26 +0000
4@@ -4149,9 +4149,13 @@
5 }
6 use strict;
7 use warnings;
8-
9+use English qw(-no_match_vars);
10 use Carp ();
11
12+eval {
13+ require IO::Socket::SSL;
14+};
15+my $have_ssl = $EVAL_ERROR ? 0 : 1;
16
17 my @attributes;
18 BEGIN {
19@@ -4329,10 +4333,8 @@
20 my ($self, $scheme, $host, $port) = @_;
21
22 if ( $scheme eq 'https' ) {
23- eval "require IO::Socket::SSL"
24- unless exists $INC{'IO/Socket/SSL.pm'};
25- croak(qq/IO::Socket::SSL must be installed for https support\n/)
26- unless $INC{'IO/Socket/SSL.pm'};
27+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
28+ unless $have_ssl;
29 }
30 elsif ( $scheme ne 'http' ) {
31 croak(qq/Unsupported URL scheme '$scheme'\n/);
32
33=== modified file 'bin/pt-config-diff'
34--- bin/pt-config-diff 2012-09-24 19:24:36 +0000
35+++ bin/pt-config-diff 2012-10-06 19:35:26 +0000
36@@ -3264,9 +3264,13 @@
37 }
38 use strict;
39 use warnings;
40-
41+use English qw(-no_match_vars);
42 use Carp ();
43
44+eval {
45+ require IO::Socket::SSL;
46+};
47+my $have_ssl = $EVAL_ERROR ? 0 : 1;
48
49 my @attributes;
50 BEGIN {
51@@ -3444,10 +3448,8 @@
52 my ($self, $scheme, $host, $port) = @_;
53
54 if ( $scheme eq 'https' ) {
55- eval "require IO::Socket::SSL"
56- unless exists $INC{'IO/Socket/SSL.pm'};
57- croak(qq/IO::Socket::SSL must be installed for https support\n/)
58- unless $INC{'IO/Socket/SSL.pm'};
59+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
60+ unless $have_ssl;
61 }
62 elsif ( $scheme ne 'http' ) {
63 croak(qq/Unsupported URL scheme '$scheme'\n/);
64
65=== modified file 'bin/pt-deadlock-logger'
66--- bin/pt-deadlock-logger 2012-09-24 19:24:36 +0000
67+++ bin/pt-deadlock-logger 2012-10-06 19:35:26 +0000
68@@ -2708,9 +2708,13 @@
69 }
70 use strict;
71 use warnings;
72-
73+use English qw(-no_match_vars);
74 use Carp ();
75
76+eval {
77+ require IO::Socket::SSL;
78+};
79+my $have_ssl = $EVAL_ERROR ? 0 : 1;
80
81 my @attributes;
82 BEGIN {
83@@ -2888,10 +2892,8 @@
84 my ($self, $scheme, $host, $port) = @_;
85
86 if ( $scheme eq 'https' ) {
87- eval "require IO::Socket::SSL"
88- unless exists $INC{'IO/Socket/SSL.pm'};
89- croak(qq/IO::Socket::SSL must be installed for https support\n/)
90- unless $INC{'IO/Socket/SSL.pm'};
91+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
92+ unless $have_ssl;
93 }
94 elsif ( $scheme ne 'http' ) {
95 croak(qq/Unsupported URL scheme '$scheme'\n/);
96
97=== modified file 'bin/pt-diskstats'
98--- bin/pt-diskstats 2012-09-24 19:24:36 +0000
99+++ bin/pt-diskstats 2012-10-06 19:35:26 +0000
100@@ -3819,9 +3819,13 @@
101 }
102 use strict;
103 use warnings;
104-
105+use English qw(-no_match_vars);
106 use Carp ();
107
108+eval {
109+ require IO::Socket::SSL;
110+};
111+my $have_ssl = $EVAL_ERROR ? 0 : 1;
112
113 my @attributes;
114 BEGIN {
115@@ -3999,10 +4003,8 @@
116 my ($self, $scheme, $host, $port) = @_;
117
118 if ( $scheme eq 'https' ) {
119- eval "require IO::Socket::SSL"
120- unless exists $INC{'IO/Socket/SSL.pm'};
121- croak(qq/IO::Socket::SSL must be installed for https support\n/)
122- unless $INC{'IO/Socket/SSL.pm'};
123+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
124+ unless $have_ssl;
125 }
126 elsif ( $scheme ne 'http' ) {
127 croak(qq/Unsupported URL scheme '$scheme'\n/);
128
129=== modified file 'bin/pt-duplicate-key-checker'
130--- bin/pt-duplicate-key-checker 2012-09-24 19:24:36 +0000
131+++ bin/pt-duplicate-key-checker 2012-10-06 19:35:26 +0000
132@@ -3665,9 +3665,13 @@
133 }
134 use strict;
135 use warnings;
136-
137+use English qw(-no_match_vars);
138 use Carp ();
139
140+eval {
141+ require IO::Socket::SSL;
142+};
143+my $have_ssl = $EVAL_ERROR ? 0 : 1;
144
145 my @attributes;
146 BEGIN {
147@@ -3845,10 +3849,8 @@
148 my ($self, $scheme, $host, $port) = @_;
149
150 if ( $scheme eq 'https' ) {
151- eval "require IO::Socket::SSL"
152- unless exists $INC{'IO/Socket/SSL.pm'};
153- croak(qq/IO::Socket::SSL must be installed for https support\n/)
154- unless $INC{'IO/Socket/SSL.pm'};
155+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
156+ unless $have_ssl;
157 }
158 elsif ( $scheme ne 'http' ) {
159 croak(qq/Unsupported URL scheme '$scheme'\n/);
160
161=== modified file 'bin/pt-find'
162--- bin/pt-find 2012-09-24 19:24:36 +0000
163+++ bin/pt-find 2012-10-06 19:35:26 +0000
164@@ -2505,9 +2505,13 @@
165 }
166 use strict;
167 use warnings;
168-
169+use English qw(-no_match_vars);
170 use Carp ();
171
172+eval {
173+ require IO::Socket::SSL;
174+};
175+my $have_ssl = $EVAL_ERROR ? 0 : 1;
176
177 my @attributes;
178 BEGIN {
179@@ -2685,10 +2689,8 @@
180 my ($self, $scheme, $host, $port) = @_;
181
182 if ( $scheme eq 'https' ) {
183- eval "require IO::Socket::SSL"
184- unless exists $INC{'IO/Socket/SSL.pm'};
185- croak(qq/IO::Socket::SSL must be installed for https support\n/)
186- unless $INC{'IO/Socket/SSL.pm'};
187+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
188+ unless $have_ssl;
189 }
190 elsif ( $scheme ne 'http' ) {
191 croak(qq/Unsupported URL scheme '$scheme'\n/);
192
193=== modified file 'bin/pt-fk-error-logger'
194--- bin/pt-fk-error-logger 2012-09-24 19:24:36 +0000
195+++ bin/pt-fk-error-logger 2012-10-06 19:35:26 +0000
196@@ -2412,9 +2412,13 @@
197 }
198 use strict;
199 use warnings;
200-
201+use English qw(-no_match_vars);
202 use Carp ();
203
204+eval {
205+ require IO::Socket::SSL;
206+};
207+my $have_ssl = $EVAL_ERROR ? 0 : 1;
208
209 my @attributes;
210 BEGIN {
211@@ -2592,10 +2596,8 @@
212 my ($self, $scheme, $host, $port) = @_;
213
214 if ( $scheme eq 'https' ) {
215- eval "require IO::Socket::SSL"
216- unless exists $INC{'IO/Socket/SSL.pm'};
217- croak(qq/IO::Socket::SSL must be installed for https support\n/)
218- unless $INC{'IO/Socket/SSL.pm'};
219+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
220+ unless $have_ssl;
221 }
222 elsif ( $scheme ne 'http' ) {
223 croak(qq/Unsupported URL scheme '$scheme'\n/);
224
225=== modified file 'bin/pt-heartbeat'
226--- bin/pt-heartbeat 2012-09-24 19:24:36 +0000
227+++ bin/pt-heartbeat 2012-10-06 19:35:26 +0000
228@@ -3589,9 +3589,13 @@
229 }
230 use strict;
231 use warnings;
232-
233+use English qw(-no_match_vars);
234 use Carp ();
235
236+eval {
237+ require IO::Socket::SSL;
238+};
239+my $have_ssl = $EVAL_ERROR ? 0 : 1;
240
241 my @attributes;
242 BEGIN {
243@@ -3769,10 +3773,8 @@
244 my ($self, $scheme, $host, $port) = @_;
245
246 if ( $scheme eq 'https' ) {
247- eval "require IO::Socket::SSL"
248- unless exists $INC{'IO/Socket/SSL.pm'};
249- croak(qq/IO::Socket::SSL must be installed for https support\n/)
250- unless $INC{'IO/Socket/SSL.pm'};
251+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
252+ unless $have_ssl;
253 }
254 elsif ( $scheme ne 'http' ) {
255 croak(qq/Unsupported URL scheme '$scheme'\n/);
256
257=== modified file 'bin/pt-index-usage'
258--- bin/pt-index-usage 2012-09-24 19:24:36 +0000
259+++ bin/pt-index-usage 2012-10-06 19:35:26 +0000
260@@ -5171,9 +5171,13 @@
261 }
262 use strict;
263 use warnings;
264-
265+use English qw(-no_match_vars);
266 use Carp ();
267
268+eval {
269+ require IO::Socket::SSL;
270+};
271+my $have_ssl = $EVAL_ERROR ? 0 : 1;
272
273 my @attributes;
274 BEGIN {
275@@ -5351,10 +5355,8 @@
276 my ($self, $scheme, $host, $port) = @_;
277
278 if ( $scheme eq 'https' ) {
279- eval "require IO::Socket::SSL"
280- unless exists $INC{'IO/Socket/SSL.pm'};
281- croak(qq/IO::Socket::SSL must be installed for https support\n/)
282- unless $INC{'IO/Socket/SSL.pm'};
283+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
284+ unless $have_ssl;
285 }
286 elsif ( $scheme ne 'http' ) {
287 croak(qq/Unsupported URL scheme '$scheme'\n/);
288
289=== modified file 'bin/pt-kill'
290--- bin/pt-kill 2012-09-24 19:24:36 +0000
291+++ bin/pt-kill 2012-10-06 19:35:26 +0000
292@@ -5180,9 +5180,13 @@
293 }
294 use strict;
295 use warnings;
296-
297+use English qw(-no_match_vars);
298 use Carp ();
299
300+eval {
301+ require IO::Socket::SSL;
302+};
303+my $have_ssl = $EVAL_ERROR ? 0 : 1;
304
305 my @attributes;
306 BEGIN {
307@@ -5360,10 +5364,8 @@
308 my ($self, $scheme, $host, $port) = @_;
309
310 if ( $scheme eq 'https' ) {
311- eval "require IO::Socket::SSL"
312- unless exists $INC{'IO/Socket/SSL.pm'};
313- croak(qq/IO::Socket::SSL must be installed for https support\n/)
314- unless $INC{'IO/Socket/SSL.pm'};
315+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
316+ unless $have_ssl;
317 }
318 elsif ( $scheme ne 'http' ) {
319 croak(qq/Unsupported URL scheme '$scheme'\n/);
320
321=== modified file 'bin/pt-online-schema-change'
322--- bin/pt-online-schema-change 2012-09-24 19:24:36 +0000
323+++ bin/pt-online-schema-change 2012-10-06 19:35:26 +0000
324@@ -6202,9 +6202,13 @@
325 }
326 use strict;
327 use warnings;
328-
329+use English qw(-no_match_vars);
330 use Carp ();
331
332+eval {
333+ require IO::Socket::SSL;
334+};
335+my $have_ssl = $EVAL_ERROR ? 0 : 1;
336
337 my @attributes;
338 BEGIN {
339@@ -6382,10 +6386,8 @@
340 my ($self, $scheme, $host, $port) = @_;
341
342 if ( $scheme eq 'https' ) {
343- eval "require IO::Socket::SSL"
344- unless exists $INC{'IO/Socket/SSL.pm'};
345- croak(qq/IO::Socket::SSL must be installed for https support\n/)
346- unless $INC{'IO/Socket/SSL.pm'};
347+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
348+ unless $have_ssl;
349 }
350 elsif ( $scheme ne 'http' ) {
351 croak(qq/Unsupported URL scheme '$scheme'\n/);
352
353=== modified file 'bin/pt-query-advisor'
354--- bin/pt-query-advisor 2012-09-24 19:24:36 +0000
355+++ bin/pt-query-advisor 2012-10-06 19:35:26 +0000
356@@ -6356,9 +6356,13 @@
357 }
358 use strict;
359 use warnings;
360-
361+use English qw(-no_match_vars);
362 use Carp ();
363
364+eval {
365+ require IO::Socket::SSL;
366+};
367+my $have_ssl = $EVAL_ERROR ? 0 : 1;
368
369 my @attributes;
370 BEGIN {
371@@ -6536,10 +6540,8 @@
372 my ($self, $scheme, $host, $port) = @_;
373
374 if ( $scheme eq 'https' ) {
375- eval "require IO::Socket::SSL"
376- unless exists $INC{'IO/Socket/SSL.pm'};
377- croak(qq/IO::Socket::SSL must be installed for https support\n/)
378- unless $INC{'IO/Socket/SSL.pm'};
379+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
380+ unless $have_ssl;
381 }
382 elsif ( $scheme ne 'http' ) {
383 croak(qq/Unsupported URL scheme '$scheme'\n/);
384
385=== modified file 'bin/pt-query-digest'
386--- bin/pt-query-digest 2012-10-03 21:36:15 +0000
387+++ bin/pt-query-digest 2012-10-06 19:35:26 +0000
388@@ -12205,9 +12205,13 @@
389 }
390 use strict;
391 use warnings;
392-
393+use English qw(-no_match_vars);
394 use Carp ();
395
396+eval {
397+ require IO::Socket::SSL;
398+};
399+my $have_ssl = $EVAL_ERROR ? 0 : 1;
400
401 my @attributes;
402 BEGIN {
403@@ -12385,10 +12389,8 @@
404 my ($self, $scheme, $host, $port) = @_;
405
406 if ( $scheme eq 'https' ) {
407- eval "require IO::Socket::SSL"
408- unless exists $INC{'IO/Socket/SSL.pm'};
409- croak(qq/IO::Socket::SSL must be installed for https support\n/)
410- unless $INC{'IO/Socket/SSL.pm'};
411+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
412+ unless $have_ssl;
413 }
414 elsif ( $scheme ne 'http' ) {
415 croak(qq/Unsupported URL scheme '$scheme'\n/);
416
417=== modified file 'bin/pt-slave-delay'
418--- bin/pt-slave-delay 2012-09-24 19:24:36 +0000
419+++ bin/pt-slave-delay 2012-10-06 19:35:26 +0000
420@@ -2821,9 +2821,13 @@
421 }
422 use strict;
423 use warnings;
424-
425+use English qw(-no_match_vars);
426 use Carp ();
427
428+eval {
429+ require IO::Socket::SSL;
430+};
431+my $have_ssl = $EVAL_ERROR ? 0 : 1;
432
433 my @attributes;
434 BEGIN {
435@@ -3001,10 +3005,8 @@
436 my ($self, $scheme, $host, $port) = @_;
437
438 if ( $scheme eq 'https' ) {
439- eval "require IO::Socket::SSL"
440- unless exists $INC{'IO/Socket/SSL.pm'};
441- croak(qq/IO::Socket::SSL must be installed for https support\n/)
442- unless $INC{'IO/Socket/SSL.pm'};
443+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
444+ unless $have_ssl;
445 }
446 elsif ( $scheme ne 'http' ) {
447 croak(qq/Unsupported URL scheme '$scheme'\n/);
448
449=== modified file 'bin/pt-slave-restart'
450--- bin/pt-slave-restart 2012-09-24 19:24:36 +0000
451+++ bin/pt-slave-restart 2012-10-06 19:35:26 +0000
452@@ -3444,9 +3444,13 @@
453 }
454 use strict;
455 use warnings;
456-
457+use English qw(-no_match_vars);
458 use Carp ();
459
460+eval {
461+ require IO::Socket::SSL;
462+};
463+my $have_ssl = $EVAL_ERROR ? 0 : 1;
464
465 my @attributes;
466 BEGIN {
467@@ -3624,10 +3628,8 @@
468 my ($self, $scheme, $host, $port) = @_;
469
470 if ( $scheme eq 'https' ) {
471- eval "require IO::Socket::SSL"
472- unless exists $INC{'IO/Socket/SSL.pm'};
473- croak(qq/IO::Socket::SSL must be installed for https support\n/)
474- unless $INC{'IO/Socket/SSL.pm'};
475+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
476+ unless $have_ssl;
477 }
478 elsif ( $scheme ne 'http' ) {
479 croak(qq/Unsupported URL scheme '$scheme'\n/);
480
481=== modified file 'bin/pt-table-checksum'
482--- bin/pt-table-checksum 2012-10-05 21:43:51 +0000
483+++ bin/pt-table-checksum 2012-10-06 19:35:26 +0000
484@@ -370,9 +370,13 @@
485 }
486 use strict;
487 use warnings;
488-
489+use English qw(-no_match_vars);
490 use Carp ();
491
492+eval {
493+ require IO::Socket::SSL;
494+};
495+my $have_ssl = $EVAL_ERROR ? 0 : 1;
496
497 my @attributes;
498 BEGIN {
499@@ -550,10 +554,8 @@
500 my ($self, $scheme, $host, $port) = @_;
501
502 if ( $scheme eq 'https' ) {
503- eval "require IO::Socket::SSL"
504- unless exists $INC{'IO/Socket/SSL.pm'};
505- croak(qq/IO::Socket::SSL must be installed for https support\n/)
506- unless $INC{'IO/Socket/SSL.pm'};
507+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
508+ unless $have_ssl;
509 }
510 elsif ( $scheme ne 'http' ) {
511 croak(qq/Unsupported URL scheme '$scheme'\n/);
512
513=== modified file 'bin/pt-table-sync'
514--- bin/pt-table-sync 2012-09-20 13:59:16 +0000
515+++ bin/pt-table-sync 2012-10-06 19:35:26 +0000
516@@ -8578,9 +8578,13 @@
517 }
518 use strict;
519 use warnings;
520-
521+use English qw(-no_match_vars);
522 use Carp ();
523
524+eval {
525+ require IO::Socket::SSL;
526+};
527+my $have_ssl = $EVAL_ERROR ? 0 : 1;
528
529 my @attributes;
530 BEGIN {
531@@ -8758,10 +8762,8 @@
532 my ($self, $scheme, $host, $port) = @_;
533
534 if ( $scheme eq 'https' ) {
535- eval "require IO::Socket::SSL"
536- unless exists $INC{'IO/Socket/SSL.pm'};
537- croak(qq/IO::Socket::SSL must be installed for https support\n/)
538- unless $INC{'IO/Socket/SSL.pm'};
539+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
540+ unless $have_ssl;
541 }
542 elsif ( $scheme ne 'http' ) {
543 croak(qq/Unsupported URL scheme '$scheme'\n/);
544@@ -8782,8 +8784,14 @@
545 IO::Socket::SSL->start_SSL($self->{fh});
546 ref($self->{fh}) eq 'IO::Socket::SSL'
547 or die(qq/SSL connection failed for $host\n/);
548- $self->{fh}->verify_hostname( $host, $ssl_verify_args )
549- or die(qq/SSL certificate not valid for $host\n/);
550+ if ( $self->{fh}->can("verify_hostname") ) {
551+ $self->{fh}->verify_hostname( $host, $ssl_verify_args );
552+ }
553+ else {
554+ my $fh = $self->{fh};
555+ _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
556+ or die(qq/SSL certificate not valid for $host\n/);
557+ }
558 }
559
560 $self->{host} = $host;
561@@ -9026,6 +9034,179 @@
562 return $self->_do_timeout('write', @_)
563 }
564
565+my $prog = <<'EOP';
566+BEGIN {
567+ if ( defined &IO::Socket::SSL::CAN_IPV6 ) {
568+ *CAN_IPV6 = \*IO::Socket::SSL::CAN_IPV6;
569+ }
570+ else {
571+ constant->import( CAN_IPV6 => '' );
572+ }
573+ my %const = (
574+ NID_CommonName => 13,
575+ GEN_DNS => 2,
576+ GEN_IPADD => 7,
577+ );
578+ while ( my ($name,$value) = each %const ) {
579+ no strict 'refs';
580+ *{$name} = UNIVERSAL::can( 'Net::SSLeay', $name ) || sub { $value };
581+ }
582+}
583+{
584+ my %dispatcher = (
585+ issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
586+ subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
587+ );
588+ if ( $Net::SSLeay::VERSION >= 1.30 ) {
589+ $dispatcher{commonName} = sub {
590+ my $cn = Net::SSLeay::X509_NAME_get_text_by_NID(
591+ Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName);
592+ $cn =~s{\0$}{}; # work around Bug in Net::SSLeay <1.33
593+ $cn;
594+ }
595+ } else {
596+ $dispatcher{commonName} = sub {
597+ croak "you need at least Net::SSLeay version 1.30 for getting commonName"
598+ }
599+ }
600+
601+ if ( $Net::SSLeay::VERSION >= 1.33 ) {
602+ $dispatcher{subjectAltNames} = sub { Net::SSLeay::X509_get_subjectAltNames( shift ) };
603+ } else {
604+ $dispatcher{subjectAltNames} = sub {
605+ return;
606+ };
607+ }
608+
609+ $dispatcher{authority} = $dispatcher{issuer};
610+ $dispatcher{owner} = $dispatcher{subject};
611+ $dispatcher{cn} = $dispatcher{commonName};
612+
613+ sub _peer_certificate {
614+ my ($self, $field) = @_;
615+ my $ssl = $self->_get_ssl_object or return;
616+
617+ my $cert = ${*$self}{_SSL_certificate}
618+ ||= Net::SSLeay::get_peer_certificate($ssl)
619+ or return $self->error("Could not retrieve peer certificate");
620+
621+ if ($field) {
622+ my $sub = $dispatcher{$field} or croak
623+ "invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ).
624+ "\nMaybe you need to upgrade your Net::SSLeay";
625+ return $sub->($cert);
626+ } else {
627+ return $cert
628+ }
629+ }
630+
631+
632+ my %scheme = (
633+ ldap => {
634+ wildcards_in_cn => 0,
635+ wildcards_in_alt => 'leftmost',
636+ check_cn => 'always',
637+ },
638+ http => {
639+ wildcards_in_cn => 'anywhere',
640+ wildcards_in_alt => 'anywhere',
641+ check_cn => 'when_only',
642+ },
643+ smtp => {
644+ wildcards_in_cn => 0,
645+ wildcards_in_alt => 0,
646+ check_cn => 'always'
647+ },
648+ none => {}, # do not check
649+ );
650+
651+ $scheme{www} = $scheme{http}; # alias
652+ $scheme{xmpp} = $scheme{http}; # rfc 3920
653+ $scheme{pop3} = $scheme{ldap}; # rfc 2595
654+ $scheme{imap} = $scheme{ldap}; # rfc 2595
655+ $scheme{acap} = $scheme{ldap}; # rfc 2595
656+ $scheme{nntp} = $scheme{ldap}; # rfc 4642
657+ $scheme{ftp} = $scheme{http}; # rfc 4217
658+
659+
660+ sub _verify_hostname_of_cert {
661+ my $identity = shift;
662+ my $cert = shift;
663+ my $scheme = shift || 'none';
664+ if ( ! ref($scheme) ) {
665+ $scheme = $scheme{$scheme} or croak "scheme $scheme not defined";
666+ }
667+
668+ return 1 if ! %$scheme; # 'none'
669+
670+ my $commonName = $dispatcher{cn}->($cert);
671+ my @altNames = $dispatcher{subjectAltNames}->($cert);
672+
673+ if ( my $sub = $scheme->{callback} ) {
674+ return $sub->($identity,$commonName,@altNames);
675+ }
676+
677+
678+ my $ipn;
679+ if ( CAN_IPV6 and $identity =~m{:} ) {
680+ $ipn = IO::Socket::SSL::inet_pton(IO::Socket::SSL::AF_INET6,$identity)
681+ or croak "'$identity' is not IPv6, but neither IPv4 nor hostname";
682+ } elsif ( $identity =~m{^\d+\.\d+\.\d+\.\d+$} ) {
683+ $ipn = IO::Socket::SSL::inet_aton( $identity ) or croak "'$identity' is not IPv4, but neither IPv6 nor hostname";
684+ } else {
685+ if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) {
686+ $identity =~m{\0} and croak("name '$identity' has \\0 byte");
687+ $identity = IO::Socket::SSL::idn_to_ascii($identity) or
688+ croak "Warning: Given name '$identity' could not be converted to IDNA!";
689+ }
690+ }
691+
692+ my $check_name = sub {
693+ my ($name,$identity,$wtyp) = @_;
694+ $wtyp ||= '';
695+ my $pattern;
696+ if ( $wtyp eq 'anywhere' and $name =~m{^([a-zA-Z0-9_\-]*)\*(.+)} ) {
697+ $pattern = qr{^\Q$1\E[a-zA-Z0-9_\-]*\Q$2\E$}i;
698+ } elsif ( $wtyp eq 'leftmost' and $name =~m{^\*(\..+)$} ) {
699+ $pattern = qr{^[a-zA-Z0-9_\-]*\Q$1\E$}i;
700+ } else {
701+ $pattern = qr{^\Q$name\E$}i;
702+ }
703+ return $identity =~ $pattern;
704+ };
705+
706+ my $alt_dnsNames = 0;
707+ while (@altNames) {
708+ my ($type, $name) = splice (@altNames, 0, 2);
709+ if ( $ipn and $type == GEN_IPADD ) {
710+ return 1 if $ipn eq $name;
711+
712+ } elsif ( ! $ipn and $type == GEN_DNS ) {
713+ $name =~s/\s+$//; $name =~s/^\s+//;
714+ $alt_dnsNames++;
715+ $check_name->($name,$identity,$scheme->{wildcards_in_alt})
716+ and return 1;
717+ }
718+ }
719+
720+ if ( ! $ipn and (
721+ $scheme->{check_cn} eq 'always' or
722+ $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames)) {
723+ $check_name->($commonName,$identity,$scheme->{wildcards_in_cn})
724+ and return 1;
725+ }
726+
727+ return 0; # no match
728+ }
729+}
730+EOP
731+
732+eval { require IO::Socket::SSL };
733+if ( $INC{"IO/Socket/SSL.pm"} ) {
734+ eval $prog;
735+ die $@ if $@;
736+}
737+
738 1;
739 }
740 # ###########################################################################
741@@ -9113,8 +9294,10 @@
742 print "# Percona suggests these upgrades:\n";
743 print join("\n", map { "# * $_" } @$advice), "\n\n";
744 }
745- elsif ( $ENV{PTVCDEBUG} || PTDEBUG ) {
746- _d('--version-check worked, but there were no suggestions');
747+ else {
748+ print "# No suggestions at this time.\n\n";
749+ ($ENV{PTVCDEBUG} || PTDEBUG )
750+ && _d('--version-check worked, but there were no suggestions');
751 }
752 };
753 if ( $EVAL_ERROR ) {
754@@ -9287,7 +9470,7 @@
755
756 sub _touch {
757 my ($file) = @_;
758- sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK
759+ sysopen my $fh, $file, O_WRONLY|O_CREAT
760 or die "Cannot create $file : $!";
761 close $fh or die "Cannot close $file : $!";
762 utime(undef, undef, $file);
763
764=== modified file 'bin/pt-upgrade'
765--- bin/pt-upgrade 2012-09-24 19:24:36 +0000
766+++ bin/pt-upgrade 2012-10-06 19:35:26 +0000
767@@ -10646,9 +10646,13 @@
768 }
769 use strict;
770 use warnings;
771-
772+use English qw(-no_match_vars);
773 use Carp ();
774
775+eval {
776+ require IO::Socket::SSL;
777+};
778+my $have_ssl = $EVAL_ERROR ? 0 : 1;
779
780 my @attributes;
781 BEGIN {
782@@ -10826,10 +10830,8 @@
783 my ($self, $scheme, $host, $port) = @_;
784
785 if ( $scheme eq 'https' ) {
786- eval "require IO::Socket::SSL"
787- unless exists $INC{'IO/Socket/SSL.pm'};
788- croak(qq/IO::Socket::SSL must be installed for https support\n/)
789- unless $INC{'IO/Socket/SSL.pm'};
790+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
791+ unless $have_ssl;
792 }
793 elsif ( $scheme ne 'http' ) {
794 croak(qq/Unsupported URL scheme '$scheme'\n/);
795
796=== modified file 'bin/pt-variable-advisor'
797--- bin/pt-variable-advisor 2012-09-24 19:24:36 +0000
798+++ bin/pt-variable-advisor 2012-10-06 19:35:26 +0000
799@@ -3733,9 +3733,13 @@
800 }
801 use strict;
802 use warnings;
803-
804+use English qw(-no_match_vars);
805 use Carp ();
806
807+eval {
808+ require IO::Socket::SSL;
809+};
810+my $have_ssl = $EVAL_ERROR ? 0 : 1;
811
812 my @attributes;
813 BEGIN {
814@@ -3913,10 +3917,8 @@
815 my ($self, $scheme, $host, $port) = @_;
816
817 if ( $scheme eq 'https' ) {
818- eval "require IO::Socket::SSL"
819- unless exists $INC{'IO/Socket/SSL.pm'};
820- croak(qq/IO::Socket::SSL must be installed for https support\n/)
821- unless $INC{'IO/Socket/SSL.pm'};
822+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
823+ unless $have_ssl;
824 }
825 elsif ( $scheme ne 'http' ) {
826 croak(qq/Unsupported URL scheme '$scheme'\n/);
827
828=== modified file 'lib/HTTPMicro.pm'
829--- lib/HTTPMicro.pm 2012-09-24 19:24:36 +0000
830+++ lib/HTTPMicro.pm 2012-10-06 19:35:26 +0000
831@@ -28,9 +28,13 @@
832 }
833 use strict;
834 use warnings;
835-
836+use English qw(-no_match_vars);
837 use Carp ();
838
839+eval {
840+ require IO::Socket::SSL;
841+};
842+my $have_ssl = $EVAL_ERROR ? 0 : 1;
843
844 my @attributes;
845 BEGIN {
846@@ -210,10 +214,8 @@
847 my ($self, $scheme, $host, $port) = @_;
848
849 if ( $scheme eq 'https' ) {
850- eval "require IO::Socket::SSL"
851- unless exists $INC{'IO/Socket/SSL.pm'};
852- croak(qq/IO::Socket::SSL must be installed for https support\n/)
853- unless $INC{'IO/Socket/SSL.pm'};
854+ croak(qq/IO::Socket::SSL must be installed for HTTPS support\n/)
855+ unless $have_ssl;
856 }
857 elsif ( $scheme ne 'http' ) {
858 croak(qq/Unsupported URL scheme '$scheme'\n/);
859
860=== modified file 't/lib/HTTPMicro.t'
861--- t/lib/HTTPMicro.t 2012-09-24 19:24:36 +0000
862+++ t/lib/HTTPMicro.t 2012-10-06 19:35:26 +0000
863@@ -13,23 +13,36 @@
864
865 use HTTPMicro;
866
867-local $EVAL_ERROR;
868 eval { require HTTP::Tiny };
869 if ( $EVAL_ERROR ) {
870 plan skip_all => "HTTP::Tiny is not installed";
871 }
872
873-# Need a simple URL that won't try to do chunking.
874-for my $test_url ( "http://www.percona.com/robots.txt", "https://v.percona.com" ) {
875- my $tiny = HTTP::Tiny->new(max_redirect => 0)->request('GET', $test_url);
876- my $micro = HTTPMicro->new->request('GET', $test_url);
877+eval { require IO::Socket::SSL };
878+my $have_ssl = $EVAL_ERROR ? 0 : 1;
879+
880+# HTTP::Mircro does not support chunking, so don't test against
881+# a URL with contents that will chunk.
882+
883+sub test_url {
884+ my ($url) = @_;
885+
886+ my $tiny = HTTP::Tiny->new(max_redirect => 0)->request('GET', $url);
887+ my $micro = HTTPMicro->new->request('GET', $url);
888
889 is_deeply(
890 $micro->{content},
891 $tiny->{content},
892- "HTTPMicro behaves like HTTP::Tiny (max_redirect=0)"
893+ "HTTPMicro == HTTP::Tiny for $url",
894 );
895 }
896
897+test_url("http://www.percona.com/robots.txt");
898+
899+SKIP: {
900+ skip "IO::Socket::SSL is not installed", 1 unless $have_ssl;
901+ test_url("https://v.percona.com");
902+}
903+
904 done_testing;
905 exit;

Subscribers

People subscribed via source and target branches