initial import
Apocalypse
15 years ago
0 | use Module::Build; | |
1 | my $build = Module::Build->new( | |
2 | # look up Module::Build::API for the info! | |
3 | 'dynamic_config' => 0, | |
4 | 'module_name' => 'POE::Component::SSLify', | |
5 | 'license' => 'perl', | |
6 | ||
7 | 'dist_abstract' => 'SSL in the world of POE made easy', | |
8 | ||
9 | 'create_packlist' => 1, | |
10 | 'create_makefile_pl' => 'traditional', | |
11 | 'create_readme' => 1, | |
12 | ||
13 | 'test_files' => 't/*.t', | |
14 | ||
15 | 'add_to_cleanup' => [ 'META.yml', 'Makefile.PL', 'README' ], # automatically generated | |
16 | ||
17 | 'requires' => { | |
18 | # Networking | |
19 | 'Net::SSLeay' => '1.30', | |
20 | ||
21 | # Test stuff | |
22 | 'Test::More' => 0, | |
23 | }, | |
24 | ||
25 | 'recommends' => { | |
26 | # boo! | |
27 | }, | |
28 | ||
29 | # FIXME wishlist... | |
30 | # 'test_requires' => { | |
31 | # # Test stuff | |
32 | # 'Test::Compile' => 0, | |
33 | # 'Test::Perl::Critic' => 0, | |
34 | # 'Test::Dependencies' => 0, | |
35 | # 'Test::Distribution' => 0, | |
36 | # 'Test::Fixme' => 0, | |
37 | # 'Test::HasVersion' => 0, | |
38 | # 'Test::Kwalitee' => 0, | |
39 | # 'Test::CheckManifest' => 0, | |
40 | # 'Test::MinimumVersion' => 0, | |
41 | # 'Test::Pod::Coverage' => 0, | |
42 | # 'Test::Spelling' => 0, | |
43 | # 'Test::Pod' => 0, | |
44 | # 'Test::Prereq' => 0, | |
45 | # 'Test::Strict' => 0, | |
46 | # 'Test::UseAllModules' => 0, | |
47 | # }, | |
48 | ); | |
49 | ||
50 | # all done! | |
51 | $build->create_build_script; |
0 | Revision history for Perl extension POE::Component::SSLify. | |
1 | ||
2 | * 0.14 | |
3 | ||
4 | removed Test::* modules from dependency list, thanks BINGOS - RT #36725 | |
5 | ||
6 | dos2unix fixes - thanks RT #36704 | |
7 | ||
8 | added Build.PL | |
9 | ||
10 | * 0.13 | |
11 | ||
12 | POD typo errors in SSLify_ContextCreate - thanks ASCENT! | |
13 | ||
14 | * 0.12 | |
15 | ||
16 | Kwalitee-related fixes | |
17 | ||
18 | * 0.11 | |
19 | ||
20 | allowed setting of client-side context ( $ctx ) object - thanks RT #34442 | |
21 | ||
22 | squashed typo in pod - thanks ASCENT! | |
23 | ||
24 | changed version check code to regexp for compatibility with SSLeay v1.33_01 - thanks Mark! | |
25 | ||
26 | added SSLify_ContextCreate helper function | |
27 | ||
28 | backported Net::SSLeay's removal of %Filenum_Objects hash | |
29 | ||
30 | * 0.10 | |
31 | ||
32 | More tweaks of POD - finally close RT #31238 | |
33 | Added SSL version support - thanks RT #31492 | |
34 | Added SSL CTX option support as a side effect | |
35 | Added client.pl example with ReadLine support | |
36 | ||
37 | * 0.09 | |
38 | ||
39 | Minor tweak of POD to enable better distro building - thanks RT #31238 | |
40 | ||
41 | * 0.08 | |
42 | ||
43 | Added support for BINMODE - thanks RT #27117 | |
44 | ||
45 | * 0.07 | |
46 | ||
47 | Fixed undefined $info - thanks RT #22372 | |
48 | ||
49 | * 0.06 | |
50 | ||
51 | Kwalitee-related fixes | |
52 | ||
53 | * 0.05 | |
54 | ||
55 | Finally use a Changes file - thanks RT #18981 | |
56 | Documentation tweaks | |
57 | Upgraded Net::SSLeay requirement to 1.30 to help Win32 problems | |
58 | ||
59 | * 0.04 | |
60 | ||
61 | Added new functions to extract data from the SSL socket -> GetCipher and GetSocket | |
62 | In the case somebody knows Net::SSLeay more than me, added GetCTX to return the server-side CTX object | |
63 | Removed the dependency on Net::SSLeay::Handle | |
64 | ||
65 | * 0.03 | |
66 | ||
67 | First stab at the server-side code, help me test it out! | |
68 | Refactored SSLify() into client/server side, so update your program accordingly! | |
69 | ||
70 | * 0.02 | |
71 | ||
72 | Made sure the IO::Handle way was used only on MSWin32 | |
73 | ||
74 | * SSLify::ServerHandle | |
75 | Removed _CIPHER and moved it to the main SSLify.pm code | |
76 | Oops, forgot to override _get_self and _get_ssl | |
77 | Fixed a nasty leak issue | |
78 | ||
79 | * 0.01 | |
80 | ||
81 | Initial release |
0 | Build.PL | |
1 | Changes | |
2 | examples/client.pl | |
3 | examples/server.pl | |
4 | lib/POE/Component/SSLify.pm | |
5 | lib/POE/Component/SSLify/ClientHandle.pm | |
6 | lib/POE/Component/SSLify/ServerHandle.pm | |
7 | Makefile.PL | |
8 | MANIFEST | |
9 | MANIFEST.SKIP | |
10 | META.yml | |
11 | README | |
12 | t/load.t | |
13 | t/a_critic.t | |
14 | t/a_kwalitee.t | |
15 | t/a_pod.t | |
16 | t/a_pod_spelling.t | |
17 | t/a_pod_coverage.t | |
18 | t/a_strict.t | |
19 | t/a_hasversion.t | |
20 | t/a_minimumversion.t | |
21 | t/a_manifest.t | |
22 | t/a_distribution.t | |
23 | t/a_compile.t | |
24 | t/a_dependencies.t | |
25 | t/a_fixme.t | |
26 | t/a_prereq.t | |
27 | t/a_prereq_build.t | |
28 | t/a_dosnewline.t |
0 | # Avoid Eclipse stuff | |
1 | \.includepath$ | |
2 | \.project$ | |
3 | \.settings/ | |
4 | ||
5 | # Avoid version control files. | |
6 | \B\.svn\b | |
7 | ||
8 | # Avoid Makemaker generated and utility files. | |
9 | \bMANIFEST\.SKIP | |
10 | \bMakefile$ | |
11 | \bblib/ | |
12 | \bMakeMaker-\d | |
13 | \bpm_to_blib$ | |
14 | ||
15 | # Avoid Module::Build generated and utility files. | |
16 | \bBuild$ | |
17 | \b_build/ | |
18 | ||
19 | # Avoid temp and backup files. | |
20 | ~$ | |
21 | \.old$ | |
22 | \#$ | |
23 | \b\.# | |
24 | \.bak$ | |
25 | ||
26 | # our tarballs | |
27 | \.tar\.gz$ |
0 | use ExtUtils::MakeMaker; | |
1 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence | |
2 | # the contents of the Makefile that is written. | |
3 | WriteMakefile( | |
4 | 'NAME' => 'POE::Component::SSLify', | |
5 | 'VERSION_FROM' => 'lib/POE/Component/SSLify.pm', | |
6 | 'PREREQ_PM' => { | |
7 | 'Net::SSLeay' => '1.30', | |
8 | }, | |
9 | ( $] >= 5.005 ? # Add new keywords | |
10 | ( | |
11 | 'ABSTRACT_FROM' => 'lib/POE/Component/SSLify.pm', # retrieve abstract from module | |
12 | 'AUTHOR' => 'Apocalypse <APOCAL@cpan.org>', | |
13 | 'LICENSE' => 'perl', | |
14 | ) : () | |
15 | ), | |
16 | ); |
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
Binary diff not shown
0 | #!/usr/bin/perl | |
1 | use strict; use warnings; | |
2 | ||
3 | use POE; | |
4 | use POE::Component::SSLify qw( Client_SSLify ); | |
5 | use POE::Wheel::ReadWrite; | |
6 | use POE::Wheel::SocketFactory; | |
7 | use POE::Driver::SysRW; | |
8 | use POE::Filter::Line; | |
9 | use POE::Wheel::ReadLine; | |
10 | ||
11 | POE::Session->create( | |
12 | 'inline_states' => { | |
13 | '_start' => sub { | |
14 | # Set the alias | |
15 | $_[KERNEL]->alias_set( 'main' ); | |
16 | ||
17 | # Setup our ReadLine stuff | |
18 | $_[HEAP]->{'RL'} = POE::Wheel::ReadLine->new( | |
19 | 'InputEvent' => 'Got_ReadLine', | |
20 | ); | |
21 | ||
22 | # Connect to the server! | |
23 | $_[KERNEL]->yield( 'do_connect' ); | |
24 | return 1; | |
25 | }, | |
26 | 'do_connect' => sub { | |
27 | # Create the socketfactory wheel to listen for requests | |
28 | $_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new( | |
29 | 'RemotePort' => 5432, | |
30 | 'RemoteAddress' => 'localhost', | |
31 | 'Reuse' => 'yes', | |
32 | 'SuccessEvent' => 'Got_Connection', | |
33 | 'FailureEvent' => 'ConnectError', | |
34 | ); | |
35 | return 1; | |
36 | }, | |
37 | 'Got_ReadLine' => sub { | |
38 | if ( defined $_[ARG0] ) { | |
39 | if ( exists $_[HEAP]->{'WHEEL'} ) { | |
40 | $_[HEAP]->{'WHEEL'}->put( $_[ARG0] ); | |
41 | } | |
42 | } else { | |
43 | if ( $_[ARG1] eq 'interrupt' ) { | |
44 | die 'stopped'; | |
45 | } | |
46 | } | |
47 | }, | |
48 | 'Got_Connection' => sub { | |
49 | # ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port | |
50 | my $socket = $_[ ARG0 ]; | |
51 | ||
52 | # SSLify it! | |
53 | $socket = Client_SSLify( $socket ); | |
54 | ||
55 | # Hand it off to ReadWrite | |
56 | my $wheel = POE::Wheel::ReadWrite->new( | |
57 | 'Handle' => $socket, | |
58 | 'Driver' => POE::Driver::SysRW->new(), | |
59 | 'Filter' => POE::Filter::Line->new(), | |
60 | 'InputEvent' => 'Got_Input', | |
61 | 'ErrorEvent' => 'Got_Error', | |
62 | ); | |
63 | ||
64 | # Store it... | |
65 | $_[HEAP]->{'WHEEL'} = $wheel; | |
66 | $_[HEAP]->{'RL'}->put( 'Connected to SSL server' ); | |
67 | $_[HEAP]->{'RL'}->get( 'Input: ' ); | |
68 | ||
69 | return 1; | |
70 | }, | |
71 | 'ConnectError' => sub { | |
72 | # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID | |
73 | my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ]; | |
74 | warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n"; | |
75 | delete $_[HEAP]->{'SOCKETFACTORY'}; | |
76 | $_[HEAP]->{'RL'}->put( 'Unable to connect to SSL server...' ); | |
77 | $_[KERNEL]->delay_set( 'do_connect', 5 ); | |
78 | return 1; | |
79 | }, | |
80 | 'Got_Input' => sub { | |
81 | # ARG0: The Line, ARG1: Wheel ID | |
82 | ||
83 | # Send back to the client the line! | |
84 | $_[HEAP]->{'RL'}->put( 'Got Reply: ' . $_[ARG0] ); | |
85 | $_[HEAP]->{'RL'}->get( 'Input: ' ); | |
86 | return 1; | |
87 | }, | |
88 | 'Got_Error' => sub { | |
89 | # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID | |
90 | my ( $operation, $errnum, $errstr, $id ) = @_[ ARG0 .. ARG3 ]; | |
91 | warn "Wheel $id generated $operation error $errnum: $errstr\n"; | |
92 | delete $_[HEAP]->{'WHEEL'}; | |
93 | $_[HEAP]->{'RL'}->put( 'Disconnected from SSL server...' ); | |
94 | $_[KERNEL]->delay_set( 'do_connect', 5 ); | |
95 | return 1; | |
96 | }, | |
97 | }, | |
98 | ); | |
99 | ||
100 | # Start POE! | |
101 | POE::Kernel->run(); | |
102 | exit 0; |
0 | #!/usr/bin/perl | |
1 | use strict; use warnings; | |
2 | ||
3 | use POE; | |
4 | use Socket qw( inet_ntoa unpack_sockaddr_in ); | |
5 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options SSLify_GetCipher SSLify_GetSocket ); | |
6 | use POE::Wheel::ReadWrite; | |
7 | use POE::Wheel::SocketFactory; | |
8 | use POE::Driver::SysRW; | |
9 | use POE::Filter::Line; | |
10 | ||
11 | POE::Session->create( | |
12 | 'inline_states' => { | |
13 | '_start' => sub { | |
14 | # Okay, set the SSL options | |
15 | SSLify_Options( 'server.key', 'server.crt' ); | |
16 | ||
17 | # Set the alias | |
18 | $_[KERNEL]->alias_set( 'main' ); | |
19 | ||
20 | # Create the socketfactory wheel to listen for requests | |
21 | $_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new( | |
22 | 'BindPort' => 5432, | |
23 | 'BindAddress' => 'localhost', | |
24 | 'Reuse' => 'yes', | |
25 | 'SuccessEvent' => 'Got_Connection', | |
26 | 'FailureEvent' => 'ListenerError', | |
27 | ); | |
28 | return 1; | |
29 | }, | |
30 | 'Got_Connection' => sub { | |
31 | # ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port | |
32 | my $socket = $_[ ARG0 ]; | |
33 | ||
34 | # SSLify it! | |
35 | $socket = Server_SSLify( $socket ); | |
36 | ||
37 | # testing stuff | |
38 | warn "got connection from: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $socket ) ) ) )[1] ) . " cipher type: " . SSLify_GetCipher( $socket ); | |
39 | ||
40 | # Hand it off to ReadWrite | |
41 | my $wheel = POE::Wheel::ReadWrite->new( | |
42 | 'Handle' => $socket, | |
43 | 'Driver' => POE::Driver::SysRW->new(), | |
44 | 'Filter' => POE::Filter::Line->new(), | |
45 | 'InputEvent' => 'Got_Input', | |
46 | 'FlushedEvent' => 'Got_Flush', | |
47 | 'ErrorEvent' => 'Got_Error', | |
48 | ); | |
49 | ||
50 | # Store it... | |
51 | $_[HEAP]->{'WHEELS'}->{ $wheel->ID } = $wheel; | |
52 | return 1; | |
53 | }, | |
54 | 'ListenerError' => sub { | |
55 | # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID | |
56 | my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ]; | |
57 | warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n"; | |
58 | ||
59 | return 1; | |
60 | }, | |
61 | 'Got_Input' => sub { | |
62 | # ARG0: The Line, ARG1: Wheel ID | |
63 | ||
64 | # Send back to the client the line! | |
65 | $_[HEAP]->{'WHEELS'}->{ $_[ARG1] }->put( $_[ARG0] ); | |
66 | return 1; | |
67 | }, | |
68 | 'Got_Flush' => sub { | |
69 | # We don't care about this event | |
70 | return 1; | |
71 | }, | |
72 | 'Got_Error' => sub { | |
73 | # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID | |
74 | my ( $operation, $errnum, $errstr, $id ) = @_[ ARG0 .. ARG3 ]; | |
75 | warn "Wheel $id generated $operation error $errnum: $errstr\n"; | |
76 | ||
77 | # Done with a wheel | |
78 | delete $_[HEAP]->{'WHEELS'}->{ $_[ARG0] }; | |
79 | return 1; | |
80 | }, | |
81 | }, | |
82 | ); | |
83 | ||
84 | # Start POE! | |
85 | POE::Kernel->run(); | |
86 | exit 0; |
0 | # $Id: ClientHandle.pm 53 2008-07-28 03:03:04Z larwan $ | |
1 | package POE::Component::SSLify::ClientHandle; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = (qw$LastChangedRevision: 53 $)[1]; | |
7 | ||
8 | # Import the SSL death routines | |
9 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
10 | ||
11 | # We inherit from ServerHandle | |
12 | use vars qw( @ISA ); | |
13 | require POE::Component::SSLify::ServerHandle; | |
14 | @ISA = qw( POE::Component::SSLify::ServerHandle ); | |
15 | ||
16 | # Override TIEHANDLE because we create a CTX | |
17 | sub TIEHANDLE { | |
18 | my ( $class, $socket, $version, $options, $ctx ) = @_; | |
19 | ||
20 | # create a context, if necessary | |
21 | if ( ! defined $ctx ) { | |
22 | $ctx = POE::Component::SSLify::createSSLcontext( undef, undef, $version, $options ); | |
23 | } | |
24 | ||
25 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
26 | ||
27 | my $fileno = fileno( $socket ); | |
28 | ||
29 | Net::SSLeay::set_fd( $ssl, $fileno ); # Must use fileno | |
30 | ||
31 | my $resp = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' ); | |
32 | ||
33 | my $self = bless { | |
34 | 'ssl' => $ssl, | |
35 | 'ctx' => $ctx, | |
36 | 'socket' => $socket, | |
37 | 'fileno' => $fileno, | |
38 | 'client' => 1, | |
39 | }, $class; | |
40 | ||
41 | return $self; | |
42 | } | |
43 | ||
44 | # End of module | |
45 | 1; | |
46 | ||
47 | __END__ | |
48 | ||
49 | =head1 NAME | |
50 | ||
51 | POE::Component::SSLify::ClientHandle - client object for POE::Component::SSLify | |
52 | ||
53 | =head1 ABSTRACT | |
54 | ||
55 | See POE::Component::SSLify::ServerHandle | |
56 | ||
57 | =head1 DESCRIPTION | |
58 | ||
59 | This is a subclass of ServerHandle to accomodate clients setting custom context objects. | |
60 | ||
61 | =head1 SEE ALSO | |
62 | ||
63 | L<POE::Component::SSLify> | |
64 | ||
65 | L<POE::Component::SSLify::ServerHandle> | |
66 | ||
67 | =head1 AUTHOR | |
68 | ||
69 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
70 | ||
71 | =head1 COPYRIGHT AND LICENSE | |
72 | ||
73 | Copyright 2008 by Apocalypse | |
74 | ||
75 | This library is free software; you can redistribute it and/or modify | |
76 | it under the same terms as Perl itself. | |
77 | ||
78 | =cut |
0 | # $Id: ServerHandle.pm 53 2008-07-28 03:03:04Z larwan $ | |
1 | package POE::Component::SSLify::ServerHandle; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = (qw$LastChangedRevision: 53 $)[1]; | |
7 | ||
8 | # Import the SSL death routines | |
9 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
10 | ||
11 | # Ties the socket | |
12 | sub TIEHANDLE { | |
13 | my ( $class, $socket, $ctx ) = @_; | |
14 | ||
15 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
16 | ||
17 | my $fileno = fileno( $socket ); | |
18 | ||
19 | Net::SSLeay::set_fd( $ssl, $fileno ); | |
20 | ||
21 | my $err = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' ); | |
22 | ||
23 | my $self = bless { | |
24 | 'ssl' => $ssl, | |
25 | 'ctx' => $ctx, | |
26 | 'socket' => $socket, | |
27 | 'fileno' => $fileno, | |
28 | }, $class; | |
29 | ||
30 | return $self; | |
31 | } | |
32 | ||
33 | # Read something from the socket | |
34 | sub READ { | |
35 | # Get ourself! | |
36 | my $self = shift; | |
37 | ||
38 | # Get the pointers to buffer, length, and the offset | |
39 | my( $buf, $len, $offset ) = \( @_ ); | |
40 | ||
41 | # If we have no offset, replace the buffer with some input | |
42 | if ( ! defined $$offset ) { | |
43 | $$buf = Net::SSLeay::read( $self->{'ssl'}, $$len ); | |
44 | ||
45 | # Are we done? | |
46 | if ( defined $$buf ) { | |
47 | return length( $$buf ); | |
48 | } else { | |
49 | # Nah, clear the buffer too... | |
50 | $$buf = ""; | |
51 | return; | |
52 | } | |
53 | } | |
54 | ||
55 | # Now, actually read the data | |
56 | defined( my $read = Net::SSLeay::read( $self->{'ssl'}, $$len ) ) or return; | |
57 | ||
58 | # Figure out the buffer and offset | |
59 | my $buf_len = length( $$buf ); | |
60 | ||
61 | # If our offset is bigger, pad the buffer | |
62 | if ( $$offset > $buf_len ) { | |
63 | $$buf .= chr( 0 ) x ( $$offset - $buf_len ); | |
64 | } | |
65 | ||
66 | # Insert what we just read into the buffer | |
67 | substr( $$buf, $$offset ) = $read; | |
68 | ||
69 | # All done! | |
70 | return length( $read ); | |
71 | } | |
72 | ||
73 | # Write some stuff to the socket | |
74 | sub WRITE { | |
75 | # Get ourself + buffer + length + offset to write | |
76 | my( $self, $buf, $len, $offset ) = @_; | |
77 | ||
78 | # If we have nothing to offset, then start from the beginning | |
79 | if ( ! defined $offset ) { | |
80 | $offset = 0; | |
81 | } | |
82 | ||
83 | # We count the number of characters written to the socket | |
84 | my $wrote_len = Net::SSLeay::write( $self->{'ssl'}, substr( $buf, $offset, $len ) ); | |
85 | ||
86 | # Did we get an error or number of bytes written? | |
87 | # Net::SSLeay::write() returns the number of bytes written, or -1 on error. | |
88 | if ( $wrote_len < 0 ) { | |
89 | # The normal syswrite() POE uses expects 0 here. | |
90 | return 0; | |
91 | } else { | |
92 | # All done! | |
93 | return $wrote_len; | |
94 | } | |
95 | } | |
96 | ||
97 | # Sets binmode on the socket | |
98 | # Thanks to RT #27117 | |
99 | sub BINMODE { | |
100 | my $self = shift; | |
101 | if (@_) { | |
102 | my $mode = shift; | |
103 | binmode $self->{'socket'}, $mode; | |
104 | } else { | |
105 | binmode $self->{'socket'}; | |
106 | } | |
107 | } | |
108 | ||
109 | # Closes the socket | |
110 | sub CLOSE { | |
111 | my $self = shift; | |
112 | if ( defined $self->{'socket'} ) { | |
113 | Net::SSLeay::free( $self->{'ssl'} ); | |
114 | close( $self->{'socket'} ); | |
115 | undef $self->{'socket'}; | |
116 | ||
117 | # do we need to do CTX_free? | |
118 | if ( exists $self->{'client'} ) { | |
119 | Net::SSLeay::CTX_free( $self->{'ctx'} ); | |
120 | } | |
121 | } | |
122 | ||
123 | return 1; | |
124 | } | |
125 | ||
126 | # Add DESTROY handler | |
127 | sub DESTROY { | |
128 | my $self = shift; | |
129 | ||
130 | # Did we already CLOSE? | |
131 | if ( defined $self->{'socket'} ) { | |
132 | # Guess not... | |
133 | $self->CLOSE(); | |
134 | } | |
135 | } | |
136 | ||
137 | sub FILENO { | |
138 | my $self = shift; | |
139 | return $self->{'fileno'}; | |
140 | } | |
141 | ||
142 | # Not implemented TIE's | |
143 | sub READLINE { | |
144 | die 'Not Implemented'; | |
145 | } | |
146 | ||
147 | sub PRINT { | |
148 | die 'Not Implemented'; | |
149 | } | |
150 | ||
151 | # End of module | |
152 | 1; | |
153 | ||
154 | __END__ | |
155 | ||
156 | =head1 NAME | |
157 | ||
158 | POE::Component::SSLify::ServerHandle - server object for POE::Component::SSLify | |
159 | ||
160 | =head1 ABSTRACT | |
161 | ||
162 | See POE::Component::SSLify | |
163 | ||
164 | =head1 DESCRIPTION | |
165 | ||
166 | This is a subclass of Net::SSLeay::Handle because their read() and sysread() | |
167 | does not cooperate well with POE. They block until length bytes are read from the | |
168 | socket, and that is BAD in the world of POE... | |
169 | ||
170 | This subclass behaves exactly the same, except that it doesn't block :) | |
171 | ||
172 | =head2 DIFFERENCES | |
173 | ||
174 | This subclass doesn't know what to do with PRINT/READLINE, as they usually are not used in POE::Wheel operations... | |
175 | ||
176 | =head1 SEE ALSO | |
177 | ||
178 | L<POE::Component::SSLify> | |
179 | ||
180 | =head1 AUTHOR | |
181 | ||
182 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
183 | ||
184 | =head1 PROPS | |
185 | ||
186 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
187 | packaged up the code into something everyone could use... | |
188 | ||
189 | From the PoCo::Client::HTTP code for blocking sockets =] | |
190 | # TODO - This code should probably become a POE::Kernel method, | |
191 | # seeing as it's rather baroque and potentially useful in a number | |
192 | # of places. | |
193 | ||
194 | =head1 COPYRIGHT AND LICENSE | |
195 | ||
196 | Copyright 2008 by Apocalypse/Rocco Caputo | |
197 | ||
198 | This library is free software; you can redistribute it and/or modify | |
199 | it under the same terms as Perl itself. | |
200 | ||
201 | =cut |
0 | # $Id: SSLify.pm 53 2008-07-28 03:03:04Z larwan $ | |
1 | package POE::Component::SSLify; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version $LastChangedRevision: 53 $ | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = '0.14'; | |
7 | ||
8 | # We need Net::SSLeay or all's a failure! | |
9 | BEGIN { | |
10 | eval { require Net::SSLeay }; | |
11 | ||
12 | # Check for errors... | |
13 | if ( $@ ) { | |
14 | # Oh boy! | |
15 | die $@; | |
16 | } else { | |
17 | # Check to make sure the versions are what we want | |
18 | if ( ! ( defined $Net::SSLeay::VERSION and | |
19 | $Net::SSLeay::VERSION =~ /^1\.3/ ) ) { | |
20 | warn 'Please upgrade Net::SSLeay to v1.30+ installed: v' . $Net::SSLeay::VERSION; | |
21 | } | |
22 | ||
23 | # Finally, load our subclass :) | |
24 | require POE::Component::SSLify::ClientHandle; | |
25 | require POE::Component::SSLify::ServerHandle; | |
26 | ||
27 | # Initialize Net::SSLeay | |
28 | Net::SSLeay::load_error_strings(); | |
29 | Net::SSLeay::SSLeay_add_ssl_algorithms(); | |
30 | Net::SSLeay::randomize(); | |
31 | } | |
32 | } | |
33 | ||
34 | # Do the exporting magic... | |
35 | require Exporter; | |
36 | use vars qw( @ISA @EXPORT_OK ); | |
37 | @ISA = qw( Exporter ); | |
38 | @EXPORT_OK = qw( Client_SSLify Server_SSLify SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket SSLify_ContextCreate ); | |
39 | ||
40 | # Bring in some socket-related stuff | |
41 | use Symbol qw( gensym ); | |
42 | use POSIX qw( F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK ); | |
43 | ||
44 | # We need the server-side stuff | |
45 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
46 | ||
47 | # The server-side CTX stuff | |
48 | my $ctx = undef; | |
49 | ||
50 | # Helper sub to set blocking on a handle | |
51 | sub Set_Blocking { | |
52 | my $socket = shift; | |
53 | ||
54 | # Net::SSLeay needs blocking for setup. | |
55 | # | |
56 | # ActiveState Perl 5.8.0 dislikes the Win32-specific code to make | |
57 | # a socket blocking, so we use IO::Handle's blocking(1) method. | |
58 | # Perl 5.005_03 doesn't like blocking(), so we only use it in | |
59 | # 5.8.0 and beyond. | |
60 | if ( $] >= 5.008 and $^O eq 'MSWin32' ) { | |
61 | # From IO::Handle POD | |
62 | # If an error occurs blocking will return undef and $! will be set. | |
63 | if ( ! $socket->blocking( 1 ) ) { | |
64 | die "Unable to set blocking mode on socket: $!"; | |
65 | } | |
66 | } else { | |
67 | # Make the handle blocking, the POSIX way. | |
68 | if ( $^O ne 'MSWin32' ) { | |
69 | # Get the old flags | |
70 | my $flags = fcntl( $socket, F_GETFL, 0 ) or die "fcntl( $socket, F_GETFL, 0 ) fails: $!"; | |
71 | ||
72 | # Okay, we patiently wait until the socket turns blocking mode | |
73 | until( fcntl( $socket, F_SETFL, $flags & ~O_NONBLOCK ) ) { | |
74 | # What was the error? | |
75 | if ( ! ( $! == EAGAIN or $! == EWOULDBLOCK ) ) { | |
76 | # Fatal error... | |
77 | die "fcntl( $socket, FSETFL, etc ) fails: $!"; | |
78 | } | |
79 | } | |
80 | } else { | |
81 | # Darned MSWin32 way... | |
82 | # Do some ioctl magic here | |
83 | # 126 is FIONBIO ( some docs say 0x7F << 16 ) | |
84 | my $flag = "0"; | |
85 | ioctl( $socket, 0x80000000 | ( 4 << 16 ) | ( ord( 'f' ) << 8 ) | 126, $flag ) or die "ioctl( $socket, FIONBIO, $flag ) fails: $!"; | |
86 | } | |
87 | } | |
88 | ||
89 | # All done! | |
90 | return $socket; | |
91 | } | |
92 | ||
93 | # Okay, the main routine here! | |
94 | sub Client_SSLify { | |
95 | # Get the socket + version + options + ctx | |
96 | my( $socket, $version, $options, $ctx ) = @_; | |
97 | ||
98 | # Validation... | |
99 | if ( ! defined $socket ) { | |
100 | die "Did not get a defined socket"; | |
101 | } | |
102 | ||
103 | # Set blocking on | |
104 | $socket = Set_Blocking( $socket ); | |
105 | ||
106 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
107 | my $newsock = gensym(); | |
108 | tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx ) or die "Unable to tie to our subclass: $!"; | |
109 | ||
110 | # All done! | |
111 | return $newsock; | |
112 | } | |
113 | ||
114 | # Okay, the main routine here! | |
115 | sub Server_SSLify { | |
116 | # Get the socket! | |
117 | my $socket = shift; | |
118 | ||
119 | # Validation... | |
120 | if ( ! defined $socket ) { | |
121 | die "Did not get a defined socket"; | |
122 | } | |
123 | ||
124 | # If we don't have a ctx ready, we can't do anything... | |
125 | if ( ! defined $ctx ) { | |
126 | die 'Please do SSLify_Options() first'; | |
127 | } | |
128 | ||
129 | # Set blocking on | |
130 | $socket = Set_Blocking( $socket ); | |
131 | ||
132 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
133 | my $newsock = gensym(); | |
134 | tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, $ctx ) or die "Unable to tie to our subclass: $!"; | |
135 | ||
136 | # All done! | |
137 | return $newsock; | |
138 | } | |
139 | ||
140 | sub SSLify_ContextCreate { | |
141 | # Get the key + cert + version + options | |
142 | my( $key, $cert, $version, $options ) = @_; | |
143 | ||
144 | return createSSLcontext( $key, $cert, $version, $options ); | |
145 | } | |
146 | ||
147 | sub SSLify_Options { | |
148 | # Get the key + cert + version + options | |
149 | my( $key, $cert, $version, $options ) = @_; | |
150 | ||
151 | # sanity | |
152 | if ( ! defined $key or ! defined $cert ) { | |
153 | die 'no key/cert specified'; | |
154 | return; | |
155 | } | |
156 | ||
157 | # Set the default | |
158 | if ( ! defined $options ) { | |
159 | $options = &Net::SSLeay::OP_ALL; | |
160 | } | |
161 | ||
162 | # set the context, possibly overwriting the previous one | |
163 | if ( defined $ctx ) { | |
164 | Net::SSLeay::CTX_free( $ctx ); | |
165 | undef $ctx; | |
166 | } | |
167 | $ctx = createSSLcontext( $key, $cert, $version, $options ); | |
168 | ||
169 | # all done! | |
170 | return 1; | |
171 | } | |
172 | ||
173 | sub createSSLcontext { | |
174 | my( $key, $cert, $version, $options ) = @_; | |
175 | ||
176 | my $context; | |
177 | if ( defined $version and ! ref $version ) { | |
178 | if ( $version eq 'sslv2' ) { | |
179 | $context = Net::SSLeay::CTX_v2_new(); | |
180 | } elsif ( $version eq 'sslv3' ) { | |
181 | $context = Net::SSLeay::CTX_v3_new(); | |
182 | } elsif ( $version eq 'tlsv1' ) { | |
183 | $context = Net::SSLeay::CTX_tlsv1_new(); | |
184 | } elsif ( $version eq 'default' ) { | |
185 | $context = Net::SSLeay::CTX_new(); | |
186 | } else { | |
187 | die "unknown SSL version: $version"; | |
188 | return; | |
189 | } | |
190 | } else { | |
191 | $context = Net::SSLeay::CTX_new(); | |
192 | } | |
193 | if ( ! defined $context ) { | |
194 | die_now( "Failed to create SSL_CTX $!" ); | |
195 | return; | |
196 | } | |
197 | ||
198 | # do we need to set options? | |
199 | if ( defined $options ) { | |
200 | Net::SSLeay::CTX_set_options( $context, $options ) and die_if_ssl_error( 'ssl ctx set options' ); | |
201 | } | |
202 | ||
203 | # do we need to set key/etc? | |
204 | if ( defined $key ) { | |
205 | # Following will ask password unless private key is not encrypted | |
206 | Net::SSLeay::CTX_use_RSAPrivateKey_file( $context, $key, &Net::SSLeay::FILETYPE_PEM ); | |
207 | die_if_ssl_error( 'private key' ); | |
208 | } | |
209 | ||
210 | # Set the cert file | |
211 | if ( defined $cert ) { | |
212 | Net::SSLeay::CTX_use_certificate_file( $context, $cert, &Net::SSLeay::FILETYPE_PEM ); | |
213 | die_if_ssl_error( 'certificate' ); | |
214 | } | |
215 | ||
216 | # All done! | |
217 | return $context; | |
218 | } | |
219 | ||
220 | # Returns the server-side CTX in case somebody wants to play with it | |
221 | sub SSLify_GetCTX { | |
222 | my $sock = shift; | |
223 | if ( ! defined $sock ) { | |
224 | return $ctx; | |
225 | } else { | |
226 | return tied( *$sock )->{'ctx'}; | |
227 | } | |
228 | } | |
229 | ||
230 | # Gives you the cipher type of a SSLified socket | |
231 | sub SSLify_GetCipher { | |
232 | my $sock = shift; | |
233 | return Net::SSLeay::get_cipher( tied( *$sock )->{'ssl'} ); | |
234 | } | |
235 | ||
236 | # Gives you the "Real" Socket to play with | |
237 | sub SSLify_GetSocket { | |
238 | my $sock = shift; | |
239 | return tied( *$sock )->{'socket'}; | |
240 | } | |
241 | ||
242 | # End of module | |
243 | 1; | |
244 | ||
245 | __END__ | |
246 | ||
247 | =head1 NAME | |
248 | ||
249 | POE::Component::SSLify - Makes using SSL in the world of POE easy! | |
250 | ||
251 | =head1 SYNOPSIS | |
252 | ||
253 | =head2 Client-side usage | |
254 | ||
255 | # Import the module | |
256 | use POE::Component::SSLify qw( Client_SSLify ); | |
257 | ||
258 | # Create a normal SocketFactory wheel or something | |
259 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
260 | ||
261 | # Converts the socket into a SSL socket POE can communicate with | |
262 | eval { $socket = Client_SSLify( $socket ) }; | |
263 | if ( $@ ) { | |
264 | # Unable to SSLify it... | |
265 | } | |
266 | ||
267 | # Now, hand it off to ReadWrite | |
268 | my $rw = POE::Wheel::ReadWrite->new( | |
269 | Handle => $socket, | |
270 | ... | |
271 | ); | |
272 | ||
273 | # Use it as you wish... | |
274 | ||
275 | =head2 Server-side usage | |
276 | ||
277 | # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl | |
278 | # excellent howto: http://www.akadia.com/services/ssh_test_certificate.html | |
279 | ||
280 | # Import the module | |
281 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options ); | |
282 | ||
283 | # Set the key + certificate file | |
284 | eval { SSLify_Options( 'server.key', 'server.crt' ) }; | |
285 | if ( $@ ) { | |
286 | # Unable to load key or certificate file... | |
287 | } | |
288 | ||
289 | # Create a normal SocketFactory wheel or something | |
290 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
291 | ||
292 | # Converts the socket into a SSL socket POE can communicate with | |
293 | eval { $socket = Server_SSLify( $socket ) }; | |
294 | if ( $@ ) { | |
295 | # Unable to SSLify it... | |
296 | } | |
297 | ||
298 | # Now, hand it off to ReadWrite | |
299 | my $rw = POE::Wheel::ReadWrite->new( | |
300 | Handle => $socket, | |
301 | ... | |
302 | ); | |
303 | ||
304 | # Use it as you wish... | |
305 | ||
306 | =head1 ABSTRACT | |
307 | ||
308 | Makes SSL use in POE a breeze! | |
309 | ||
310 | =head1 DESCRIPTION | |
311 | ||
312 | This component represents the standard way to do SSL in POE. | |
313 | ||
314 | =head1 NOTES | |
315 | ||
316 | =head2 Socket methods doesn't work | |
317 | ||
318 | The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like | |
319 | getpeername() or getsockname(). The only way to do it is to use SSLify_GetSocket and then operate on | |
320 | the socket it returns. | |
321 | ||
322 | =head2 Dying everywhere... | |
323 | ||
324 | This module will die() if Net::SSLeay could not be loaded or it is not the version we want. So, it is recommended | |
325 | that you check for errors and not use SSL, like so: | |
326 | ||
327 | eval { use POE::Component::SSLify }; | |
328 | if ( $@ ) { | |
329 | $sslavailable = 0; | |
330 | } else { | |
331 | $sslavailable = 1; | |
332 | } | |
333 | ||
334 | # Make socket SSL! | |
335 | if ( $sslavailable ) { | |
336 | eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) }; | |
337 | if ( $@ ) { | |
338 | # Unable to SSLify the socket... | |
339 | } | |
340 | } | |
341 | ||
342 | =head2 Mixing Server/Client in the same program | |
343 | ||
344 | Some users have reported success, others failure when they tried to utilize SSLify in both roles. This | |
345 | would require more investigation, so please tread carefully if you need to use it! | |
346 | ||
347 | =head1 FUNCTIONS | |
348 | ||
349 | =head2 Client_SSLify | |
350 | ||
351 | Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL | |
352 | context data. | |
353 | my $socket = shift; # get the socket from somewhere | |
354 | $socket = Client_SSLify( $socket ); # the default | |
355 | $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context | |
356 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context | |
357 | ||
358 | If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify | |
359 | will create it from the $version + $options parameters. | |
360 | ||
361 | Known versions: | |
362 | * sslv2 | |
363 | * sslv3 | |
364 | * tlsv1 | |
365 | * default | |
366 | ||
367 | By default we use the version: default | |
368 | ||
369 | By default we don't set any options | |
370 | ||
371 | NOTE: The way to have a client socket with proper certificates set up is: | |
372 | my $socket = shift; # get the socket from somewhere | |
373 | my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' ); | |
374 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); | |
375 | ||
376 | BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the | |
377 | socket is destroyed. This means you cannot reuse contexts! | |
378 | ||
379 | =head2 Server_SSLify | |
380 | ||
381 | Accepts a socket, returns a brand new socket SSLified | |
382 | my $socket = shift; # get the socket from somewhere | |
383 | $socket = Server_SSLify( $socket ); | |
384 | ||
385 | NOTE: SSLify_Options must be set first! | |
386 | ||
387 | =head2 SSLify_Options | |
388 | ||
389 | Accepts the location of the SSL key + certificate files and does it's job | |
390 | ||
391 | Optionally accepts the SSL version + CTX options | |
392 | SSLify_Options( $key, $cert, $version, $options ); | |
393 | ||
394 | Known versions: | |
395 | * sslv2 | |
396 | * sslv3 | |
397 | * tlsv1 | |
398 | * default | |
399 | ||
400 | By default we use the version: default | |
401 | ||
402 | By default we use the options: &Net::SSLeay::OP_ALL | |
403 | ||
404 | =head2 SSLify_GetCTX | |
405 | ||
406 | Returns the server-side CTX in case you wanted to play around with it :) | |
407 | ||
408 | If passed in a socket, it will return that socket's $ctx instead of the global. | |
409 | my $ctx = SSLify_GetCTX(); # get the one set via SSLify_Options | |
410 | my $ctx = SSLify_GetCTX( $sslified_sock ); # get the one in the object | |
411 | ||
412 | =head2 SSLify_GetCipher | |
413 | ||
414 | Returns the cipher used by the SSLified socket | |
415 | ||
416 | Example: | |
417 | print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n"; | |
418 | ||
419 | =head2 SSLify_GetSocket | |
420 | ||
421 | Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname() | |
422 | ||
423 | Example: | |
424 | print "Remote IP is: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[1] ) . "\n"; | |
425 | ||
426 | =head2 SSLify_ContextCreate | |
427 | ||
428 | Accepts some options, and returns a brand-new SSL context object ( $ctx ) | |
429 | my $ctx = SSLify_ContextCreate(); | |
430 | my $ctx = SSLify_ContextCreate( $key, $cert ); | |
431 | my $ctx = SSLify_ContextCreate( $key, $cert, $version, $options ); | |
432 | ||
433 | Known versions: | |
434 | * sslv2 | |
435 | * sslv3 | |
436 | * tlsv1 | |
437 | * default | |
438 | ||
439 | By default we use the version: default | |
440 | ||
441 | By default we don't set any options | |
442 | ||
443 | By default we don't use the SSL key + certificate files | |
444 | ||
445 | =head1 EXPORT | |
446 | ||
447 | Stuffs all of the above functions in @EXPORT_OK so you have to request them directly | |
448 | ||
449 | =head1 BUGS | |
450 | ||
451 | On Win32 platforms SSL support is pretty shaky, please help me out with detailed error descriptions if it happens to you! | |
452 | ||
453 | =head1 SEE ALSO | |
454 | ||
455 | L<POE> | |
456 | ||
457 | L<Net::SSLeay> | |
458 | ||
459 | =head1 AUTHOR | |
460 | ||
461 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
462 | ||
463 | =head1 PROPS | |
464 | ||
465 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
466 | packaged up the code into something everyone could use and accepted the burden | |
467 | of maintaining it :) | |
468 | ||
469 | From the PoCo::Client::HTTP code =] | |
470 | # TODO - This code should probably become a POE::Kernel method, | |
471 | # seeing as it's rather baroque and potentially useful in a number | |
472 | # of places. | |
473 | ||
474 | =head1 COPYRIGHT AND LICENSE | |
475 | ||
476 | Copyright 2008 by Apocalypse/Rocco Caputo | |
477 | ||
478 | This library is free software; you can redistribute it and/or modify | |
479 | it under the same terms as Perl itself. | |
480 | ||
481 | =cut |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Compile"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Compile required for validating the perl files'; | |
11 | } else { | |
12 | all_pm_files_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_CRITIC} ) { | |
9 | plan skip_all => 'PerlCritic test. Sent $ENV{PERL_TEST_CRITIC} to a true value to run.'; | |
10 | } else { | |
11 | # did we get a severity level? | |
12 | if ( length $ENV{PERL_TEST_CRITIC} > 1 ) { | |
13 | eval "use Test::Perl::Critic ( -severity => \"$ENV{PERL_TEST_CRITIC}\" );"; | |
14 | } else { | |
15 | eval "use Test::Perl::Critic;"; | |
16 | #eval "use Test::Perl::Critic ( -severity => 'stern' );"; | |
17 | } | |
18 | ||
19 | if ( $@ ) { | |
20 | plan skip_all => 'Test::Perl::Critic required to criticise perl files'; | |
21 | } else { | |
22 | all_critic_ok( 'lib/' ); | |
23 | } | |
24 | } | |
25 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Dependencies exclude => [ qw/ POE::Component::SSLify / ]"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Dependencies required to test perl module deps'; | |
11 | } else { | |
12 | ok_dependencies(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "require Test::Distribution"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Distribution required for validating the dist'; | |
11 | } else { | |
12 | Test::Distribution->import( not => 'podcover' ); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use File::Find::Rule"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'File::Find::Rule required for checking for presence of DOS newlines'; | |
11 | } else { | |
12 | plan tests => 1; | |
13 | ||
14 | # generate the file list | |
15 | my $rule = File::Find::Rule->new; | |
16 | $rule->grep( qr/\r\n/ ); | |
17 | my @files = $rule->in( qw( lib t examples ) ); | |
18 | ||
19 | # FIXME read in MANIFEST.SKIP and use it! | |
20 | # for now, we skip SVN stuff | |
21 | @files = grep { $_ !~ /\/\.svn\// } @files; | |
22 | ||
23 | # do we have any? | |
24 | if ( scalar @files ) { | |
25 | fail( 'newline check' ); | |
26 | diag( 'DOS newlines found in these files:' ); | |
27 | foreach my $f ( @files ) { | |
28 | diag( ' ' . $f ); | |
29 | } | |
30 | } else { | |
31 | pass( 'newline check' ); | |
32 | } | |
33 | } | |
34 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Fixme"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Fixme required for checking for presence of to-do stuff!'; | |
11 | } else { | |
12 | run_tests( | |
13 | 'where' => [ 'lib', 't' ], | |
14 | 'match' => 'FIX' . 'ME', # weird work-around suggested in POD so we don't catch ourself! | |
15 | ); | |
16 | } | |
17 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::HasVersion"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::HasVersion required for testing for version numbers'; | |
11 | } else { | |
12 | all_pm_version_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "require Test::Kwalitee"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Kwalitee required for measuring the kwalitee'; | |
11 | } else { | |
12 | Test::Kwalitee->import(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::CheckManifest"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::CheckManifest required for validating the MANIFEST'; | |
11 | } else { | |
12 | ok_manifest( { | |
13 | 'filter' => [ qr/\.svn/, qr/\.tar\.gz$/ ], | |
14 | } ); | |
15 | } | |
16 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::MinimumVersion"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::MinimumVersion required to test minimum perl version'; | |
11 | } else { | |
12 | all_minimum_version_from_metayml_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_POD} ) { | |
9 | plan skip_all => 'POD test. Sent $ENV{PERL_TEST_POD} to a true value to run.'; | |
10 | } else { | |
11 | eval "use Test::Pod"; | |
12 | if ( $@ ) { | |
13 | plan skip_all => 'Test::Pod required for testing POD'; | |
14 | } else { | |
15 | all_pod_files_ok(); | |
16 | } | |
17 | } | |
18 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_POD} ) { | |
9 | plan skip_all => 'POD test. Sent $ENV{PERL_TEST_POD} to a true value to run.'; | |
10 | } else { | |
11 | eval "use Test::Pod::Coverage"; | |
12 | if ( $@ ) { | |
13 | plan skip_all => "Test::Pod::Coverage required for testing POD coverage"; | |
14 | } else { | |
15 | # FIXME not used now | |
16 | #all_pod_coverage_ok( 'lib/'); | |
17 | plan skip_all => 'not done yet'; | |
18 | } | |
19 | } | |
20 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_POD} ) { | |
9 | plan skip_all => 'POD test. Sent $ENV{PERL_TEST_POD} to a true value to run.'; | |
10 | } else { | |
11 | eval "use Test::Spelling"; | |
12 | if ( $@ ) { | |
13 | plan skip_all => 'Test::Spelling required to test POD for spelling errors'; | |
14 | } else { | |
15 | # FIXME need to figure out how to add custom vocabulary to dictionary | |
16 | all_pod_files_spelling_ok(); | |
17 | } | |
18 | } | |
19 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Prereq"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Prereq required to test perl module deps'; | |
11 | } else { | |
12 | prereq_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Prereq::Build"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Prereq required to test perl module deps'; | |
11 | } else { | |
12 | prereq_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Strict"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Strict required to test strictness'; | |
11 | } else { | |
12 | all_perl_files_ok( 'lib/' ); | |
13 | } | |
14 | } |