Codebase list libpoe-component-sslify-perl / 935820c
cleanup chmod errors + reinit tests Apocalypse 15 years ago
44 changed file(s) with 446 addition(s) and 46 deletion(s). Raw diff Collapse all Expand all
(No changes)
(No changes)
(No changes)
(No changes)
+0
-17
Makefile.PL.old less more
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 );
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( Client_SSLify 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 use POE::Wheel::ReadLine;
11
12 # create the server
13 POE::Session->create(
14 'inline_states' => {
15 '_start' => sub {
16 # Okay, set the SSL options
17 SSLify_Options( 'server.key', 'server.crt' );
18
19 # Set the alias
20 $_[KERNEL]->alias_set( 'server' );
21
22 # Create the socketfactory wheel to listen for requests
23 $_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new(
24 'BindPort' => 5432,
25 'BindAddress' => 'localhost',
26 'Reuse' => 'yes',
27 'SuccessEvent' => 'Got_Connection',
28 'FailureEvent' => 'ListenerError',
29 );
30 return 1;
31 },
32 'Got_Connection' => sub {
33 # ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port
34 my $socket = $_[ ARG0 ];
35
36 # SSLify it!
37 $socket = Server_SSLify( $socket );
38
39 # testing stuff
40 warn "got connection from: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $socket ) ) ) )[1] ) . " cipher type: " . SSLify_GetCipher( $socket );
41
42 # Hand it off to ReadWrite
43 my $wheel = POE::Wheel::ReadWrite->new(
44 'Handle' => $socket,
45 'Driver' => POE::Driver::SysRW->new(),
46 'Filter' => POE::Filter::Line->new(),
47 'InputEvent' => 'Got_Input',
48 'FlushedEvent' => 'Got_Flush',
49 'ErrorEvent' => 'Got_Error',
50 );
51
52 # Store it...
53 $_[HEAP]->{'WHEELS'}->{ $wheel->ID } = $wheel;
54 return 1;
55 },
56 'ListenerError' => sub {
57 # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
58 my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ];
59 warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n";
60
61 return 1;
62 },
63 'Got_Input' => sub {
64 # ARG0: The Line, ARG1: Wheel ID
65
66 # Send back to the client the line!
67 $_[HEAP]->{'WHEELS'}->{ $_[ARG1] }->put( $_[ARG0] );
68 return 1;
69 },
70 'Got_Flush' => sub {
71 # We don't care about this event
72 return 1;
73 },
74 'Got_Error' => sub {
75 # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
76 my ( $operation, $errnum, $errstr, $id ) = @_[ ARG0 .. ARG3 ];
77 warn "Wheel $id generated $operation error $errnum: $errstr\n";
78
79 # Done with a wheel
80 delete $_[HEAP]->{'WHEELS'}->{ $_[ARG0] };
81 return 1;
82 },
83 },
84 );
85
86 # create the client
87 POE::Session->create(
88 'inline_states' => {
89 '_start' => sub {
90 # Set the alias
91 $_[KERNEL]->alias_set( 'client' );
92
93 # Setup our ReadLine stuff
94 $_[HEAP]->{'RL'} = POE::Wheel::ReadLine->new(
95 'InputEvent' => 'Got_ReadLine',
96 );
97
98 # Connect to the server!
99 $_[KERNEL]->yield( 'do_connect' );
100 return 1;
101 },
102 'do_connect' => sub {
103 # Create the socketfactory wheel to listen for requests
104 $_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new(
105 'RemotePort' => 5432,
106 'RemoteAddress' => 'localhost',
107 'Reuse' => 'yes',
108 'SuccessEvent' => 'Got_Connection',
109 'FailureEvent' => 'ConnectError',
110 );
111 return 1;
112 },
113 'Got_ReadLine' => sub {
114 if ( defined $_[ARG0] ) {
115 if ( exists $_[HEAP]->{'WHEEL'} ) {
116 $_[HEAP]->{'WHEEL'}->put( $_[ARG0] );
117 }
118 } else {
119 if ( $_[ARG1] eq 'interrupt' ) {
120 die 'stopped';
121 }
122 }
123 },
124 'Got_Connection' => sub {
125 # ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port
126 my $socket = $_[ ARG0 ];
127
128 # SSLify it!
129 $socket = Client_SSLify( $socket );
130
131 # Hand it off to ReadWrite
132 my $wheel = POE::Wheel::ReadWrite->new(
133 'Handle' => $socket,
134 'Driver' => POE::Driver::SysRW->new(),
135 'Filter' => POE::Filter::Line->new(),
136 'InputEvent' => 'Got_Input',
137 'ErrorEvent' => 'Got_Error',
138 );
139
140 # Store it...
141 $_[HEAP]->{'WHEEL'} = $wheel;
142 $_[HEAP]->{'RL'}->put( 'Connected to SSL server' );
143 $_[HEAP]->{'RL'}->get( 'Input: ' );
144
145 return 1;
146 },
147 'ConnectError' => sub {
148 # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
149 my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ];
150 warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n";
151 delete $_[HEAP]->{'SOCKETFACTORY'};
152 $_[HEAP]->{'RL'}->put( 'Unable to connect to SSL server...' );
153 $_[KERNEL]->delay_set( 'do_connect', 5 );
154 return 1;
155 },
156 'Got_Input' => sub {
157 # ARG0: The Line, ARG1: Wheel ID
158
159 # Send back to the client the line!
160 $_[HEAP]->{'RL'}->put( 'Got Reply: ' . $_[ARG0] );
161 $_[HEAP]->{'RL'}->get( 'Input: ' );
162 return 1;
163 },
164 'Got_Error' => sub {
165 # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
166 my ( $operation, $errnum, $errstr, $id ) = @_[ ARG0 .. ARG3 ];
167 warn "Wheel $id generated $operation error $errnum: $errstr\n";
168 delete $_[HEAP]->{'WHEEL'};
169 $_[HEAP]->{'RL'}->put( 'Disconnected from SSL server...' );
170 $_[KERNEL]->delay_set( 'do_connect', 5 );
171 return 1;
172 },
173 },
174 );
175
176 # Start POE!
177 POE::Kernel->run();
178 exit 0;
0 #!/usr/bin/perl
1
2 # Import the stuff
3 # XXX no idea why this is broken for this particular dist!
4 #use Test::UseAllModules;
5 #BEGIN { all_uses_ok(); }
6
7 use Test::More tests => 4;
8 use_ok( 'POE::Component::Fuse' );
9 use_ok( 'POE::Component::Fuse::SubProcess' );
10 use_ok( 'POE::Component::Fuse::AsyncFsV' );
11 use_ok( 'POE::Component::Fuse::myFuse' );
(No changes)
(No changes)
55 if ( not $ENV{TEST_AUTHOR} ) {
66 plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.';
77 } else {
8 eval "use Test::Dependencies exclude => [ qw/ POE::Component::SSLify / ]";
8 eval "use Test::Dependencies exclude => [ qw/ POE::Component::Fuse Module::Build / ], style => 'light';";
99 if ( $@ ) {
1010 plan skip_all => 'Test::Dependencies required to test perl module deps';
1111 } else {
(No changes)
1414 # generate the file list
1515 my $rule = File::Find::Rule->new;
1616 $rule->grep( qr/\r\n/ );
17 my @files = $rule->in( qw( lib t examples ) );
17 my @files = $rule->in( qw( lib t ) );
1818
1919 # FIXME read in MANIFEST.SKIP and use it!
20 # for now, we skip SVN stuff
21 @files = grep { $_ !~ /\/\.svn\// } @files;
20 # for now, we skip SVN + git stuff
21 @files = grep { $_ !~ /(?:\/\.svn\/|\/\.git\/)/ } @files;
2222
2323 # do we have any?
2424 if ( scalar @files ) {
77 } else {
88 eval "use Test::Fixme";
99 if ( $@ ) {
10 plan skip_all => 'Test::Fixme required for checking for presence of to-do stuff!';
10 plan skip_all => 'Test::Fixme required for checking for presence of FIXMEs';
1111 } else {
1212 run_tests(
13 'where' => [ 'lib', 't' ],
14 'match' => 'FIX' . 'ME', # weird work-around suggested in POD so we don't catch ourself!
13 'where' => 'lib',
14 'match' => qr/FIXME|TODO/,
1515 );
1616 }
1717 }
(No changes)
0 #!/usr/bin/perl
1 use strict;
2 use warnings;
3 use Test::More;
4
5 # AUTHOR test
6 if ( not $ENV{TEST_AUTHOR} ) {
7 plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.';
8 } else {
9 # can we load YAML?
10 eval "use YAML";
11 if ( $@ ) {
12 plan skip_all => 'YAML is necessary to check META.yml for prerequisites!';
13 }
14
15 # can we load CPANPLUS?
16 eval "use CPANPLUS::Backend";
17 if ( $@ ) {
18 plan skip_all => 'CPANPLUS is necessary to check module versions!';
19 }
20
21 # can we load version.pm?
22 eval "use version";
23 if ( $@ ) {
24 plan skip_all => 'version.pm is necessary to compare versions!';
25 }
26
27 # does META.yml exist?
28 if ( -e 'META.yml' and -f _ ) {
29 load_yml( 'META.yml' );
30 } else {
31 # maybe one directory up?
32 if ( -e '../META.yml' and -f _ ) {
33 load_yml( '../META.yml' );
34 } else {
35 plan skip_all => 'META.yml is missing, unable to process it!';
36 }
37 }
38 }
39
40 # main entry point
41 sub load_yml {
42 # we'll load a file
43 my $file = shift;
44
45 # okay, proceed to load it!
46 my $data;
47 eval {
48 $data = YAML::LoadFile( $file );
49 };
50 if ( $@ ) {
51 plan skip_all => "Unable to load $file => $@";
52 } else {
53 note( "Loaded $file, proceeding with analysis" );
54 }
55
56 # massage the data
57 $data = $data->{'requires'};
58 delete $data->{'perl'} if exists $data->{'perl'};
59
60 # FIXME shut up warnings ( eval's fault, blame it! )
61 require version;
62
63 # init the backend ( and set some options )
64 my $cpanconfig = CPANPLUS::Configure->new;
65 $cpanconfig->set_conf( 'verbose' => 0 );
66 $cpanconfig->set_conf( 'no_update' => 1 );
67 my $cpanplus = CPANPLUS::Backend->new( $cpanconfig );
68
69 # silence CPANPLUS!
70 {
71 no warnings 'redefine';
72 eval "sub Log::Message::Handlers::cp_msg { return }";
73 eval "sub Log::Message::Handlers::cp_error { return }";
74 }
75
76 # Okay, how many prereqs do we have?
77 plan tests => scalar keys %$data;
78
79 # analyze every one of them!
80 foreach my $prereq ( keys %$data ) {
81 check_cpan( $cpanplus, $prereq, $data->{ $prereq } );
82 }
83 }
84
85 # checks a prereq against CPAN
86 sub check_cpan {
87 my $backend = shift;
88 my $prereq = shift;
89 my $version = shift;
90
91 # check CPANPLUS
92 my $module = $backend->parse_module( 'module' => $prereq );
93 if ( defined $module ) {
94 # okay, for starters we check to see if it's version 0 then we skip it
95 if ( $version eq '0' ) {
96 ok( 1, "Skipping '$prereq' because it is specified as version 0" );
97 return;
98 }
99
100 # Does the prereq have funky characters that we're unable to process now?
101 if ( $version =~ /[<>=,!]+/ ) {
102 # FIXME simplistic style of parsing
103 my @versions = split( ',', $version );
104
105 # sort them by version, descending
106 s/[\s<>=!]+// for @versions;
107 @versions = sort { $b <=> $a }
108 map { version->new( $_ ) } @versions;
109
110 # pick the highest version to use as comparison
111 $version = $versions[0];
112 }
113
114 # convert both objects to version objects so we can compare
115 $version = version->new( $version ) if ! ref $version;
116 my $cpanversion = version->new( $module->version );
117
118 # check it!
119 is( $cpanversion, $version, "Comparing '$prereq' to CPAN version" );
120 } else {
121 ok( 0, "Warning: '$prereq' is not found on CPAN!" );
122 }
123
124 return;
125 }
1010 plan skip_all => 'Test::Kwalitee required for measuring the kwalitee';
1111 } else {
1212 Test::Kwalitee->import();
13
14 # That piece of crap dumps files all over :(
15 cleanup_debian_files();
1316 }
1417 }
18
19 # Module::CPANTS::Kwalitee::Distros suck!
20 #t/a_manifest..............1/1
21 ## Failed test at t/a_manifest.t line 13.
22 ## got: 1
23 ## expected: 0
24 ## The following files are not named in the MANIFEST file: /home/apoc/workspace/VCS-perl-trunk/VCS-2.12.2/Debian_CPANTS.txt
25 ## Looks like you failed 1 test of 1.
26 #t/a_manifest.............. Dubious, test returned 1 (wstat 256, 0x100)
27 sub cleanup_debian_files {
28 foreach my $file ( qw( Debian_CPANTS.txt ../Debian_CPANTS.txt ) ) {
29 if ( -e $file and -f _ ) {
30 my $status = unlink( $file );
31 if ( ! $status ) {
32 warn "unable to unlink $file";
33 }
34 }
35 }
36
37 return;
38 }
39
1010 plan skip_all => 'Test::CheckManifest required for validating the MANIFEST';
1111 } else {
1212 ok_manifest( {
13 'filter' => [ qr/\.svn/, qr/\.tar\.gz$/ ],
13 'filter' => [ qr/\.svn/, qr/\.git/, qr/\.tar\.gz$/ ],
1414 } );
1515 }
1616 }
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::YAML::Meta";
9 if ( $@ ) {
10 plan skip_all => 'Test::YAML::Meta required for validating the meta.yml file';
11 } else {
12 meta_yaml_ok();
13 }
14 }
(No changes)
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 Perl::Metrics::Simple";
9 if ( $@ ) {
10 plan skip_all => 'Perl::Metrics::Simple required to analyze code metrics';
11 } else {
12 # do it!
13 plan tests => 1;
14 my $analzyer = Perl::Metrics::Simple->new;
15 my $analysis = $analzyer->analyze_files( 'lib/' );
16
17 if ( ok( $analysis->file_count(), 'analyzed at least one file' ) ) {
18 # only print extra stuff if necessary
19 if ( $ENV{TEST_VERBOSE} ) {
20 diag( '-- Perl Metrics Summary ( countperl ) --' );
21 diag( ' File Count: ' . $analysis->file_count );
22 diag( ' Package Count: ' . $analysis->package_count );
23 diag( ' Subroutine Count: ' . $analysis->sub_count );
24 diag( ' Total Code Lines: ' . $analysis->lines );
25 diag( ' Non-Sub Lines: ' . $analysis->main_stats->{'lines'} );
26
27 diag( '-- Subrotuine Metrics Summary --' );
28 my $summary_stats = $analysis->summary_stats;
29 diag( ' Min: lines(' . $summary_stats->{sub_length}->{min} . ') McCabe(' . $summary_stats->{sub_complexity}->{min} . ')' );
30 diag( ' Max: lines(' . $summary_stats->{sub_length}->{max} . ') McCabe(' . $summary_stats->{sub_complexity}->{max} . ')' );
31 diag( ' Mean: lines(' . $summary_stats->{sub_length}->{mean} . ') McCabe(' . $summary_stats->{sub_complexity}->{mean} . ')' );
32 diag( ' Standard Deviation: lines(' . $summary_stats->{sub_length}->{standard_deviation} . ') McCabe(' . $summary_stats->{sub_complexity}->{standard_deviation} . ')' );
33 diag( ' Median: lines(' . $summary_stats->{sub_length}->{median} . ') McCabe(' . $summary_stats->{sub_complexity}->{median} . ')' );
34
35 # set number of subs to display
36 my $num = 10;
37
38 diag( "-- Top$num subroutines by McCabe Complexity --" );
39 my @sorted_subs = sort { $b->{'mccabe_complexity'} <=> $a->{'mccabe_complexity'} } @{ $analysis->subs };
40 foreach my $i ( 0 .. ( $num - 1 ) ) {
41 diag( ' ' . $sorted_subs[$i]->{'path'} . ':' . $sorted_subs[$i]->{'name'} . ' ->' .
42 ' McCabe(' . $sorted_subs[$i]->{'mccabe_complexity'} . ')' .
43 ' lines(' . $sorted_subs[$i]->{'lines'} . ')'
44 );
45 }
46
47 diag( "-- Top$num subroutines by lines --" );
48 @sorted_subs = sort { $b->{'lines'} <=> $a->{'lines'} } @sorted_subs;
49 foreach my $i ( 0 .. ( $num - 1 ) ) {
50 diag( ' ' . $sorted_subs[$i]->{'path'} . ':' . $sorted_subs[$i]->{'name'} . ' ->' .
51 ' lines(' . $sorted_subs[$i]->{'lines'} . ')' .
52 ' McCabe(' . $sorted_subs[$i]->{'mccabe_complexity'} . ')'
53 );
54 }
55
56 #require Data::Dumper;
57 #diag( 'Summary Stats: ' . Data::Dumper::Dumper( $analysis->summary_stats ) );
58 #diag( 'File Stats: ' . Data::Dumper::Dumper( $analysis->file_stats ) );
59 }
60 }
61 }
62 }
(No changes)
(No changes)
1212 if ( $@ ) {
1313 plan skip_all => 'Test::Spelling required to test POD for spelling errors';
1414 } else {
15 # FIXME need to figure out how to add custom vocabulary to dictionary
16 all_pod_files_spelling_ok();
15 #all_pod_files_spelling_ok();
16 plan skip_all => 'need to figure out how to add custom vocabulary to dictionary';
1717 }
1818 }
1919 }
55 if ( not $ENV{TEST_AUTHOR} ) {
66 plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.';
77 } else {
8 eval "use Test::Prereq";
9 if ( $@ ) {
10 plan skip_all => 'Test::Prereq required to test perl module deps';
8 if ( not $ENV{PERL_TEST_PREREQ} ) {
9 plan skip_all => 'PREREQ test ( warning: LONG! ) Sent $ENV{PERL_TEST_PREREQ} to a true value to run.';
1110 } else {
12 prereq_ok();
11 eval "use Test::Prereq";
12 if ( $@ ) {
13 plan skip_all => 'Test::Prereq required to test perl module deps';
14 } else {
15 prereq_ok();
16 }
1317 }
1418 }
55 if ( not $ENV{TEST_AUTHOR} ) {
66 plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.';
77 } else {
8 eval "use Test::Prereq::Build";
9 if ( $@ ) {
10 plan skip_all => 'Test::Prereq required to test perl module deps';
8 if ( not $ENV{PERL_TEST_PREREQ} ) {
9 plan skip_all => 'PREREQ test ( warning: LONG! ) Sent $ENV{PERL_TEST_PREREQ} to a true value to run.';
1110 } else {
12 prereq_ok();
11 eval "use Test::Prereq::Build";
12 if ( $@ ) {
13 plan skip_all => 'Test::Prereq required to test perl module deps';
14 } else {
15 prereq_ok();
16 }
1317 }
1418 }
(No changes)
+0
-11
t/load.t less more
0 #!/usr/bin/perl
1
2 use Test::More;
3
4 # Import the stuff
5 eval "use Test::UseAllModules";
6 if ( $@ ) {
7 plan skip_all => 'Test::UseAllModules required for verifying perl modules';
8 } else {
9 all_uses_ok();
10 }