commit 51c3d504c9d5d192ea26c527d6e78c1ce6d02ae9 parent 8472a2bf436f565f20aaca6439c9bae17ebb0f40 Author: Kyle Milz <kyle@0x30.net> Date: Sat, 27 Feb 2016 16:12:13 -0700 server: move TestSL.pm to SL/Test.pm Diffstat:
29 files changed, 403 insertions(+), 403 deletions(-)
diff --git a/server/SL/Test.pm b/server/SL/Test.pm @@ -0,0 +1,308 @@ +package SL::Test::Server; +use strict; + +use IPC::Open3; + +sub new { + my $class = shift; + + my $self = {}; + bless ($self, $class); + + my $perl_args = ''; + if ($ARGV[0] eq '-c') { + $perl_args = '-MDevel::Cover'; + } + my $pid = open3(undef, undef, \*CHLD_ERR, "perl $perl_args -T sl -t -p 4729"); + + $self->{pid} = $pid; + $self->{CHLD_ERR} = \*CHLD_ERR; + return $self; +} + +sub readline { + my $self = shift; + + return readline $self->{CHLD_ERR}; +} + +sub DESTROY { + my $self = shift; + + kill 'TERM', $self->{pid}; + waitpid( $self->{pid}, 0 ); +} + +1; + +package SL::Test::Client; +use strict; +use warnings; + +use IO::Socket::SSL; +use JSON::XS; +use String::Random; +use Test; +use Time::HiRes qw(usleep); + +require "msgs.pl"; +our (%msg_num, @msg_str); + +sub new { + my $class = shift; + my $dont_register = shift || 0; + + my $self = {}; + bless ($self, $class); + + my $socket = undef; + while (! $socket) { + $socket = IO::Socket::SSL->new( + PeerHost => 'localhost', + PeerPort => 4729, + # this is needed because PeerHost is localhost and our + # SSL certificates are signed with + # absentmindedproductions.ca + SSL_verifycn_name => "absentmindedproductions.ca", + ) or usleep(50 * 1000); + } + die "failed connect or ssl handshake: $!,$SSL_ERROR" unless ($socket); + + $self->{sock} = $socket; + $self->{device_id} = undef; + + if ($dont_register == 0) { + my $string_gen = String::Random->new; + $self->{phnum} = '403' . $string_gen->randpattern('nnnnnnn'); + + my $args = { phone_number => $self->{phnum}, os => 'unix' }; + $self->{device_id} = $self->device_add($args); + + $self->device_update({ pushtoken_hex => "token_$self->{phnum}" }, 'ok'); + } + + return $self; +} + +sub device_add { + my ($self, $args, $status) = @_; + return $self->communicate('device_add', $status, $args); +} + +sub device_update { + my ($self, $args, $status) = @_; + return $self->communicate('device_update', $status, $args); +} + +sub list_add { + my ($self, $args, $status) = @_; + return $self->communicate('list_add', $status, $args); +} + +sub list_update { + my ($self, $args, $status) = @_; + return $self->communicate('list_update', $status, $args); +} + +sub list_join { + my ($self, $args, $status) = @_; + return $self->communicate('list_join', $status, $args); +} + +sub list_leave { + my ($self, $args, $status) = @_; + return $self->communicate('list_leave', $status, $args); +} + +sub friend_add { + my ($self, $args, $status) = @_; + return $self->communicate('friend_add', $status, $args); +} + +sub friend_delete { + my ($self, $args, $status) = @_; + return $self->communicate('friend_delete', $status, $args); +} + +sub lists_get { + my ($self, $status) = @_; + return $self->communicate('lists_get', $status); +} + +sub lists_get_other { + my ($self, $status) = @_; + return $self->communicate('lists_get_other', $status); +} + +sub communicate { + my ($self, $msg_type, $exp_status, $msg_data) = @_; + + # If no expected status was passed in assume 'ok' + $exp_status = 'ok' if (! defined $exp_status); + + my $msg_args->{data} = $msg_data; + + # device_add is the only message type that does not require device_id as + # a mandatory argument + $msg_args->{device_id} = $self->{device_id} if ($msg_type ne 'device_add'); + + $self->send_msg($msg_type, $msg_args); + my $resp = $self->recv_msg($msg_type); + + # Check that the received status was the same as the expected status + my $status = $resp->{status}; + ok($status, $exp_status); + + # Response indicated error, return the reason + return $resp->{reason} if ($status eq 'err'); + + # Everything looks good, return the response data + return $resp->{data}; +} + +sub send_msg { + my ($self, $msg_type, $request) = @_; + + # Request comes in as a hash ref, do this now to figure out length + my $payload = encode_json($request); + + die "invalid message type $msg_type" unless (grep { $_ eq $msg_type } @msg_str); + + my $version = 0; + my $payload_len = length($payload); + my $header = pack("nnn", $version, $msg_num{$msg_type}, $payload_len); + + my $sent_bytes = 0; + $sent_bytes += $self->send_all($header, length($header)); + $sent_bytes += $self->send_all($payload, $payload_len); + + return $sent_bytes; +} + +sub send_all { + my ($self, $bytes, $bytes_total) = @_; + + my $bytes_written = $self->{sock}->syswrite($bytes); + + die "write failed: $!" if (!defined $bytes_written); + die "wrote $bytes_written instead of $bytes_total bytes" if ($bytes_written != $bytes_total); + + return $bytes_total; +} + +sub recv_msg { + my ($self, $exp_msg_type) = @_; + + # Read header + my $header = $self->read_all(6); + my ($version, $msg_type, $payload_size) = unpack("nnn", $header); + + # Check some things + die "unsupported protocol version $version" if ($version != 0); + die "unknown message type $msg_type" if ($msg_type >= @msg_str); + die "0 byte payload" if ($payload_size == 0); + die "unexpected message type $msg_type" if ($msg_num{$exp_msg_type} != $msg_type); + + # Read again for payload, $payload_size > 0 + my $payload = $self->read_all($payload_size); + + # This will die if $payload is invalid + my $response = decode_json($payload); + + # Don't accept messages without an object root (ie array roots) + if (ref($response) ne "HASH") { + die "server didn't send back object root element"; + } + + return $response; +} + +sub read_all { + my ($self, $bytes_total) = @_; + + my $data; + my $bytes_read = 0; + while ($bytes_total > 0) { + my $read = $self->{sock}->sysread($data, $bytes_total, $bytes_read); + + die "read failed: $!" unless (defined $read); + die "read EOF on socket" if ($read == 0); + + $bytes_total -= $read; + $bytes_read += $read; + } + + return $data; +} + +sub phnum { + my ($self) = @_; + return $self->{phnum}; +} + +sub device_id { + my ($self) = @_; + return $self->{device_id}; +} + +sub set_device_id { + my ($self, $new_id) = @_; + $self->{device_id} = $new_id; +} + +sub msg_str { + return @msg_str; +} + +1; + +package SL::Test::Notify; +use strict; + +use IO::Socket::UNIX; +use JSON::XS; + +sub new { + my $class = shift; + + my $self = {}; + bless ($self, $class); + + $self->{socket_path} = "../testd.socket"; + + my $server = IO::Socket::UNIX->new( + Type => SOCK_STREAM(), + Local => $self->{socket_path}, + Listen => 1, + ); + die "$self->{socket_path}: couldn't create socket: $!\n" unless ($server); + + while (my $client = $server->accept()) { + $client->read(my $data, 4096); + my $notify = decode_json($data); + + my $num_devices = @{ $notify->{devices} }; + next if ($num_devices == 0); + + print "testd: message type '$notify->{msg_type}'\n"; + # print "testd: payload is '" . Dumper($notify->{payload}) . "'\n"; + + for (@{ $notify->{devices} }) { + #print Dumper($_); + my ($os, $push_token) = @$_; + print "testd: sending to '$push_token' os '$os'\n"; + } + } + + return $self; +} + +sub DESTROY { + my $self = shift; + + unlink $self->{socket_path}; + #kill 'TERM', $self->{pid}; + #waitpid( $self->{pid}, 0 ); +} + +1; diff --git a/server/TestSL.pm b/server/TestSL.pm @@ -1,308 +0,0 @@ -package TestSL::Server; -use strict; - -use IPC::Open3; - -sub new { - my $class = shift; - - my $self = {}; - bless ($self, $class); - - my $perl_args = ''; - if ($ARGV[0] eq '-c') { - $perl_args = '-MDevel::Cover'; - } - my $pid = open3(undef, undef, \*CHLD_ERR, "perl $perl_args -T sl -t -p 4729"); - - $self->{pid} = $pid; - $self->{CHLD_ERR} = \*CHLD_ERR; - return $self; -} - -sub readline { - my $self = shift; - - return readline $self->{CHLD_ERR}; -} - -sub DESTROY { - my $self = shift; - - kill 'TERM', $self->{pid}; - waitpid( $self->{pid}, 0 ); -} - -1; - -package TestSL::Client; -use strict; -use warnings; - -use IO::Socket::SSL; -use JSON::XS; -use String::Random; -use Test; -use Time::HiRes qw(usleep); - -require "msgs.pl"; -our (%msg_num, @msg_str); - -sub new { - my $class = shift; - my $dont_register = shift || 0; - - my $self = {}; - bless ($self, $class); - - my $socket = undef; - while (! $socket) { - $socket = IO::Socket::SSL->new( - PeerHost => 'localhost', - PeerPort => 4729, - # this is needed because PeerHost is localhost and our - # SSL certificates are signed with - # absentmindedproductions.ca - SSL_verifycn_name => "absentmindedproductions.ca", - ) or usleep(50 * 1000); - } - die "failed connect or ssl handshake: $!,$SSL_ERROR" unless ($socket); - - $self->{sock} = $socket; - $self->{device_id} = undef; - - if ($dont_register == 0) { - my $string_gen = String::Random->new; - $self->{phnum} = '403' . $string_gen->randpattern('nnnnnnn'); - - my $args = { phone_number => $self->{phnum}, os => 'unix' }; - $self->{device_id} = $self->device_add($args); - - $self->device_update({ pushtoken_hex => "token_$self->{phnum}" }, 'ok'); - } - - return $self; -} - -sub device_add { - my ($self, $args, $status) = @_; - return $self->communicate('device_add', $status, $args); -} - -sub device_update { - my ($self, $args, $status) = @_; - return $self->communicate('device_update', $status, $args); -} - -sub list_add { - my ($self, $args, $status) = @_; - return $self->communicate('list_add', $status, $args); -} - -sub list_update { - my ($self, $args, $status) = @_; - return $self->communicate('list_update', $status, $args); -} - -sub list_join { - my ($self, $args, $status) = @_; - return $self->communicate('list_join', $status, $args); -} - -sub list_leave { - my ($self, $args, $status) = @_; - return $self->communicate('list_leave', $status, $args); -} - -sub friend_add { - my ($self, $args, $status) = @_; - return $self->communicate('friend_add', $status, $args); -} - -sub friend_delete { - my ($self, $args, $status) = @_; - return $self->communicate('friend_delete', $status, $args); -} - -sub lists_get { - my ($self, $status) = @_; - return $self->communicate('lists_get', $status); -} - -sub lists_get_other { - my ($self, $status) = @_; - return $self->communicate('lists_get_other', $status); -} - -sub communicate { - my ($self, $msg_type, $exp_status, $msg_data) = @_; - - # If no expected status was passed in assume 'ok' - $exp_status = 'ok' if (! defined $exp_status); - - my $msg_args->{data} = $msg_data; - - # device_add is the only message type that does not require device_id as - # a mandatory argument - $msg_args->{device_id} = $self->{device_id} if ($msg_type ne 'device_add'); - - $self->send_msg($msg_type, $msg_args); - my $resp = $self->recv_msg($msg_type); - - # Check that the received status was the same as the expected status - my $status = $resp->{status}; - ok($status, $exp_status); - - # Response indicated error, return the reason - return $resp->{reason} if ($status eq 'err'); - - # Everything looks good, return the response data - return $resp->{data}; -} - -sub send_msg { - my ($self, $msg_type, $request) = @_; - - # Request comes in as a hash ref, do this now to figure out length - my $payload = encode_json($request); - - die "invalid message type $msg_type" unless (grep { $_ eq $msg_type } @msg_str); - - my $version = 0; - my $payload_len = length($payload); - my $header = pack("nnn", $version, $msg_num{$msg_type}, $payload_len); - - my $sent_bytes = 0; - $sent_bytes += $self->send_all($header, length($header)); - $sent_bytes += $self->send_all($payload, $payload_len); - - return $sent_bytes; -} - -sub send_all { - my ($self, $bytes, $bytes_total) = @_; - - my $bytes_written = $self->{sock}->syswrite($bytes); - - die "write failed: $!" if (!defined $bytes_written); - die "wrote $bytes_written instead of $bytes_total bytes" if ($bytes_written != $bytes_total); - - return $bytes_total; -} - -sub recv_msg { - my ($self, $exp_msg_type) = @_; - - # Read header - my $header = $self->read_all(6); - my ($version, $msg_type, $payload_size) = unpack("nnn", $header); - - # Check some things - die "unsupported protocol version $version" if ($version != 0); - die "unknown message type $msg_type" if ($msg_type >= @msg_str); - die "0 byte payload" if ($payload_size == 0); - die "unexpected message type $msg_type" if ($msg_num{$exp_msg_type} != $msg_type); - - # Read again for payload, $payload_size > 0 - my $payload = $self->read_all($payload_size); - - # This will die if $payload is invalid - my $response = decode_json($payload); - - # Don't accept messages without an object root (ie array roots) - if (ref($response) ne "HASH") { - die "server didn't send back object root element"; - } - - return $response; -} - -sub read_all { - my ($self, $bytes_total) = @_; - - my $data; - my $bytes_read = 0; - while ($bytes_total > 0) { - my $read = $self->{sock}->sysread($data, $bytes_total, $bytes_read); - - die "read failed: $!" unless (defined $read); - die "read EOF on socket" if ($read == 0); - - $bytes_total -= $read; - $bytes_read += $read; - } - - return $data; -} - -sub phnum { - my ($self) = @_; - return $self->{phnum}; -} - -sub device_id { - my ($self) = @_; - return $self->{device_id}; -} - -sub set_device_id { - my ($self, $new_id) = @_; - $self->{device_id} = $new_id; -} - -sub msg_str { - return @msg_str; -} - -1; - -package TestSL::Notify; -use strict; - -use IO::Socket::UNIX; -use JSON::XS; - -sub new { - my $class = shift; - - my $self = {}; - bless ($self, $class); - - $self->{socket_path} = "../testd.socket"; - - my $server = IO::Socket::UNIX->new( - Type => SOCK_STREAM(), - Local => $self->{socket_path}, - Listen => 1, - ); - die "$self->{socket_path}: couldn't create socket: $!\n" unless ($server); - - while (my $client = $server->accept()) { - $client->read(my $data, 4096); - my $notify = decode_json($data); - - my $num_devices = @{ $notify->{devices} }; - next if ($num_devices == 0); - - print "testd: message type '$notify->{msg_type}'\n"; - # print "testd: payload is '" . Dumper($notify->{payload}) . "'\n"; - - for (@{ $notify->{devices} }) { - #print Dumper($_); - my ($os, $push_token) = @$_; - print "testd: sending to '$push_token' os '$os'\n"; - } - } - - return $self; -} - -sub DESTROY { - my $self = shift; - - unlink $self->{socket_path}; - #kill 'TERM', $self->{pid}; - #waitpid( $self->{pid}, 0 ); -} - -1; diff --git a/server/t/bad_payloads.t b/server/t/bad_payloads.t @@ -1,17 +1,17 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 1 } -my $s = TestSL::Server->new(); +my $s = SL::Test::Server->new(); # Send a straight up unparsable json string -my $client = TestSL::Client->new(1); +my $client = SL::Test::Client->new(1); $client->send_all(pack('nnnZ*', 0, 0, 2, "{"), 8); # Send an empty array back (which is valid json but we don't use this) -$client = TestSL::Client->new(1); +$client = SL::Test::Client->new(1); $client->send_all(pack('nnnZ*', 0, 0, 2, "[]"), 9); ok(1); diff --git a/server/t/device_add.t b/server/t/device_add.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 12 } -my $server = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $server = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Constructor automatically calls device_add so no need to do it here my $devid = $A->device_id(); diff --git a/server/t/device_update.t b/server/t/device_update.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 4 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); $A->device_update({ pushtoken_hex => "AD34A9EF72DC714CED" }); diff --git a/server/t/friend_add.t b/server/t/friend_add.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 10 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Normal message $A->friend_add('54321'); diff --git a/server/t/friend_delete.t b/server/t/friend_delete.t @@ -1,12 +1,12 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 19 } -my $server = TestSL::Server->new(); -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $server = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); # A and B are mutual friends $A->friend_add($B->phnum()); diff --git a/server/t/friend_delete_unit.t b/server/t/friend_delete_unit.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 10 } -my $server = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $server = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Someone who is not your friend my $err = $A->friend_delete('12345', 'err'); diff --git a/server/t/get_other_lists_filters_my_lists.t b/server/t/get_other_lists_filters_my_lists.t @@ -1,16 +1,16 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 11 } # Check that when your mutual friends are in your own lists that you don't get # your own lists back when doing a lists_get_other request -my $server = TestSL::Server->new(); +my $server = SL::Test::Server->new(); # Create A and B -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); # B adds a new list $B->list_add({ name => 'bs new list', date => 0 }); diff --git a/server/t/header.t b/server/t/header.t @@ -1,36 +1,36 @@ use strict; use Test; -use TestSL; +use SL::Test; # XXX: This test isn't very good # - needs to check that server disconnects on these messages BEGIN { plan tests => 1 } # Need a new connection every time because server disconnects on header errors. -my $server = TestSL::Server->new(); +my $server = SL::Test::Server->new(); # Invalid message number -my $client = TestSL::Client->new(1); +my $client = SL::Test::Client->new(1); $client->send_all(pack('nnn', 0, 47837, 0), 6); # Bad protocol version -$client = TestSL::Client->new(1); +$client = SL::Test::Client->new(1); $client->send_all(pack('nnn', 101, 0, 0), 6); # Payload length that's too long -$client = TestSL::Client->new(1); +$client = SL::Test::Client->new(1); $client->send_all(pack('nnn', 0, 0, 25143), 6); # Advertised payload length longer than actual data length -$client = TestSL::Client->new(1); +$client = SL::Test::Client->new(1); $client->send_all(pack('nnnZ*', 0, 0, 5, 'ab'), 9); # Truncated header -$client = TestSL::Client->new(1); +$client = SL::Test::Client->new(1); $client->send_all(pack('nn', 101, 69), 4); # Zero bytes payload -$client = TestSL::Client->new(1); +$client = SL::Test::Client->new(1); $client->send_all(pack('nnn', 0, 0, 0), 6); ok(1); diff --git a/server/t/invalid_deviceid.t b/server/t/invalid_deviceid.t @@ -1,14 +1,14 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 42 } # Test that sending invalid device id's results in errors -my $server = TestSL::Server->new(); +my $server = SL::Test::Server->new(); # Don't register -my $A = TestSL::Client->new(1); +my $A = SL::Test::Client->new(1); my @device_ids = ('' , 'somebull$hit', 'legit'); my @good_msgs = ('the client sent a device id that was not base64', diff --git a/server/t/large_response.t b/server/t/large_response.t @@ -1,13 +1,13 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 44 } # Test that large responses > 16384 bytes work as the underlying ssl layer can # only handle that much data at a time -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); $A->list_add({ name => "$_" x 1000, date => 0}) for (1..20); diff --git a/server/t/leave_list_your_not_in.t b/server/t/leave_list_your_not_in.t @@ -1,15 +1,15 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 7 } # Send a leave_list message that contains a valid list id but the requesting # device is not currently a member of. -my $server = TestSL::Server->new(); +my $server = SL::Test::Server->new(); -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); my $list = $A->list_add({ name => 'only a can see this list', date => 0 }); diff --git a/server/t/list_add.t b/server/t/list_add.t @@ -1,12 +1,12 @@ use strict; use Scalar::Util qw(looks_like_number); use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 10 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # make sure normal list_add works my $name = 'this is a new list'; diff --git a/server/t/list_join.t b/server/t/list_join.t @@ -1,12 +1,12 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 18 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); # make A and B mutual friends $A->friend_add($B->phnum()); diff --git a/server/t/list_join_unit.t b/server/t/list_join_unit.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 7 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Try joining a list that doesn't exist my $err = $A->list_join('12345678', 'err'); diff --git a/server/t/list_leave.t b/server/t/list_leave.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 8 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); my $list = $A->list_add({ name => 'this list was made for leaving', date => 0 }); $A->list_leave($list->{num}); diff --git a/server/t/list_leave_unit.t b/server/t/list_leave_unit.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 6 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Try leaving a list your not in my $err = $A->list_leave('1234567', 'err'); diff --git a/server/t/list_reference_counting.t b/server/t/list_reference_counting.t @@ -1,13 +1,13 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 10 } # Test list reference counting to make sure they stay alive when needed -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); # A creates a new list my $list = $A->list_add({ name => 'this list will belong to B soon enough', date => 0 }); diff --git a/server/t/list_update.t b/server/t/list_update.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 19 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Test sending a request with no 'num' key my $err = $A->list_update({ name => 'some name' }, 'err'); diff --git a/server/t/lists_get.t b/server/t/lists_get.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 28 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Create 3 new lists my @stored_lists; diff --git a/server/t/lists_get_other.t b/server/t/lists_get_other.t @@ -1,13 +1,13 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 13 } # Create A and B -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); # A and B become mutual friends $A->friend_add($B->phnum()); diff --git a/server/t/multiple_friends_same_other_list.t b/server/t/multiple_friends_same_other_list.t @@ -1,17 +1,17 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 19 } # this test makes sure that when 2 friends of yours are in the same list that # your not in, that the list doesn't show up twice in your list_get_other # request. -my $s = TestSL::Server->new(); +my $s = SL::Test::Server->new(); -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); -my $C = TestSL::Client->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); +my $C = SL::Test::Client->new(); # A and B are mutual friends $A->friend_add($B->phnum()); diff --git a/server/t/no_ssl_fails.t b/server/t/no_ssl_fails.t @@ -1,14 +1,14 @@ use strict; use IO::Socket::INET; use Test; -use TestSL; +use SL::Test; use Time::HiRes qw(usleep); BEGIN { plan tests => 1 } # Check that a non-SSL connection isn't accepted -my $s = TestSL::Server->new(); +my $s = SL::Test::Server->new(); my $socket = undef; while (!defined $socket) { diff --git a/server/t/response_too_large.t b/server/t/response_too_large.t @@ -1,12 +1,12 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 24 } # Test that a message greater than 65KB doesn't get sent -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); $A->list_add({ name => 'a' x 4000, date => 0 }) for (1..20); diff --git a/server/t/two_lists_same_name.t b/server/t/two_lists_same_name.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 6 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # check that adding the same list twice works my $name = 'some list thats going to be added twice'; diff --git a/server/t/update_list_youre_not_in.t b/server/t/update_list_youre_not_in.t @@ -1,14 +1,14 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 7 } -my $s = TestSL::Server->new(); +my $s = SL::Test::Server->new(); # Create A and B -my $A = TestSL::Client->new(); -my $B = TestSL::Client->new(); +my $A = SL::Test::Client->new(); +my $B = SL::Test::Client->new(); # A adds a new list my $list = $A->list_add({ name => 'this is a new list for a', date => 0 }); diff --git a/server/t/utf8.t b/server/t/utf8.t @@ -1,11 +1,11 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 5 } -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(); # Create a new list with a name composed of 3 valid Unicode characters # - a left double quotation mark and diff --git a/server/t/zero_payload.t b/server/t/zero_payload.t @@ -1,12 +1,12 @@ use strict; use Test; -use TestSL; +use SL::Test; BEGIN { plan tests => 12 } # Create new device, turn off automatic device_add -my $s = TestSL::Server->new(); -my $A = TestSL::Client->new(1); +my $s = SL::Test::Server->new(); +my $A = SL::Test::Client->new(1); # Send size zero payload to all message types for ( $A->msg_str() ) {