commit 772576f108002e75f783f94ab03c416b12298ba2
parent 5437846c47fd4d6520880868ee0d94180ad7ed0e
Author: Kyle Milz <kyle@0x30.net>
Date: Sat, 27 Feb 2016 12:15:41 -0700
server: add new TAP harness and tests
- Test Anything Protocol (TAP) is a test runner that's pretty nice
- convert all existing tests to this
- also we now start/stop a server per test, which should make running individual
tests easier
Diffstat:
30 files changed, 965 insertions(+), 3 deletions(-)
diff --git a/gen_msgs.sh b/gen_msgs.sh
@@ -19,7 +19,6 @@ msg_types="
objc_path="ios/shlist/MsgTypes.h"
java_path="android/shlist/app/src/main/java/drsocto/shlist/MsgTypes.java"
perl_path="server/msgs.pl"
-test_path="server/tests/msgs.pl"
generated_at="generated `date`"
@@ -81,8 +80,6 @@ EOF
print_table $perl_path "our %msg_num = (" "\$msg => \$i," ");"
print_table $perl_path "our @msg_str = (" "'\$msg'," ");"
print_table $perl_path "our @msg_func = (" "\\&msg_\$msg," ");"
-
- cp $perl_path $test_path
}
gen_objc
diff --git a/server/SL.pm b/server/SL.pm
@@ -0,0 +1,260 @@
+package SL::Server;
+use strict;
+
+use IPC::Open2;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless ($self, $class);
+
+ # perl -MDevel::Cover sl -p $PORT -t &
+ my $pid = open2(\*CHLD_OUT, undef, "perl -T sl -t -p 4729");
+
+ $self->{pid} = $pid;
+ $self->{CHLD_OUT} = \*CHLD_OUT;
+ return $self;
+}
+
+sub readline {
+ my $self = shift;
+
+ return readline $self->{CHLD_OUT};
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ kill 'TERM', $self->{pid};
+ waitpid( $self->{pid}, 0 );
+}
+
+1;
+
+package SL::Client;
+use strict;
+use warnings;
+
+use Carp;
+use IO::Socket::SSL;
+use JSON::XS;
+use String::Random;
+use Test;
+use Time::HiRes qw(usleep);
+use Try::Tiny;
+
+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);
+
+ confess "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);
+
+ confess "write failed: $!" if (!defined $bytes_written);
+ confess "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
+ confess "unsupported protocol version $version" if ($version != 0);
+ confess "unknown message type $msg_type" if ($msg_type >= @msg_str);
+ confess "0 byte payload" if ($payload_size == 0);
+ confess "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);
+
+ my $response;
+ try {
+ $response = decode_json($payload);
+ } catch {
+ confess "server sent invalid json";
+ };
+
+ # Don't accept messages without an object root (ie array roots)
+ if (ref($response) ne "HASH") {
+ confess "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);
+
+ confess "read failed: $!" unless (defined $read);
+ confess "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;
diff --git a/server/t/bad_payloads.t b/server/t/bad_payloads.t
@@ -0,0 +1,14 @@
+use strict;
+use Test::More tests => 1;
+
+use_ok( 'SL' );
+
+my $server = SL::Server->new();
+
+# Send a straight up unparsable json string
+my $client = SL::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 = SL::Client->new(1);
+$client->send_all(pack('nnnZ*', 0, 0, 2, "[]"), 9);
diff --git a/server/t/device_add.t b/server/t/device_add.t
@@ -0,0 +1,31 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 12 }
+
+use SL;
+
+my $server = SL::Server->new();
+my $A = SL::Client->new();
+
+# Constructor automatically calls device_add so no need to do it here
+my $devid = $A->device_id();
+my $length = length($devid);
+ok($devid, 'm/^[a-zA-Z0-9+\/=]+$/');
+ok($length, 43);
+
+# Duplicate phone number
+my $err = $A->device_add({ phone_number => $A->phnum, os => 'unix' }, 'err');
+ok($err, 'the sent phone number already exists');
+
+# Bad phone number
+$err = $A->device_add({ phone_number => '403867530&', os => 'unix' }, 'err');
+ok($err, 'the sent phone number is not a number');
+
+# Bad operating system
+$err = $A->device_add({ phone_number => 12345, os => 'bados' }, 'err');
+ok($err, 'operating system not supported');
+
+# Good operating systems
+$A->device_add({ phone_number => 678910, os => 'android' });
+$A->device_add({ phone_number => 231455, os => 'ios' });
diff --git a/server/t/device_update.t b/server/t/device_update.t
@@ -0,0 +1,13 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 4 }
+
+use SL;
+
+my $server = SL::Server->new();
+my $A = SL::Client->new();
+
+$A->device_update({ pushtoken_hex => "AD34A9EF72DC714CED" });
+
+ok(1)
diff --git a/server/t/friend_add.t b/server/t/friend_add.t
@@ -0,0 +1,27 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 10 }
+
+use SL;
+
+my $server = SL::Server->new();
+my $A = SL::Client->new();
+
+# Normal message
+$A->friend_add('54321');
+
+# Re-add same friend
+$A->friend_add('54321');
+
+# Non numeric phone number
+my $err = $A->friend_add('123asdf', 'err');
+ok($err, 'friends phone number is not a valid phone number');
+
+# Empty phone number
+$err = $A->friend_add('', 'err');
+ok($err, 'friends phone number is not a valid phone number');
+
+# Friending yourself
+$err = $A->friend_add($A->phnum(), 'err');
+ok($err, 'device cannot add itself as a friend');
diff --git a/server/t/friend_delete.t b/server/t/friend_delete.t
@@ -0,0 +1,36 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 19 }
+
+use SL;
+
+my $server = SL::Server->new();
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+# A and B are mutual friends
+$A->friend_add($B->phnum());
+$B->friend_add($A->phnum());
+
+# A creates 2 lists
+my $As_first_list = $A->list_add({ name => "this is a's first list", date => 0 });
+$A->list_add({ name => "this is a's second list", date => 0 });
+# B creates 1 list
+$B->list_add({ name => "this is b's first list", date => 0});
+
+# B joins A's first list
+$B->list_join($As_first_list->{num});
+
+# A deletes B's friendship
+$A->friend_delete($B->phnum());
+
+# Check that:
+# - A and B are both in A's first list
+# - B can't see A's other list
+# - A can't see B's other list
+ok(scalar @{ $A->lists_get_other() }, 0);
+ok(scalar @{ $B->lists_get_other() }, 0);
+
+ok(scalar @{ $A->lists_get() }, 2);
+ok(scalar @{ $B->lists_get() }, 2);
diff --git a/server/t/friend_delete_unit.t b/server/t/friend_delete_unit.t
@@ -0,0 +1,25 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 10 }
+
+use SL;
+
+my $server = SL::Server->new();
+my $A = SL::Client->new();
+
+# Someone who is not your friend
+my $err = $A->friend_delete('12345', 'err');
+ok($err, 'friend sent for deletion was not a friend');
+
+# Non numeric friends phone number
+$err = $A->friend_delete('asdf123', 'err');
+ok($err, 'friends phone number is not a valid phone number');
+
+# Empty phone number
+$err = $A->friend_delete('', 'err');
+ok($err, 'friends phone number is not a valid phone number');
+
+# Add/delete cycle works
+$A->friend_add('12345');
+$A->friend_delete('12345');
diff --git a/server/t/get_other_lists_filters_my_lists.t b/server/t/get_other_lists_filters_my_lists.t
@@ -0,0 +1,29 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 11 }
+
+use SL;
+
+# 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 = SL::Server->new();
+
+# Create A and B
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+# B adds a new list
+$B->list_add({ name => 'bs new list', date => 0 });
+
+# A and B become mutual friends
+$A->friend_add($B->phnum());
+$B->friend_add($A->phnum());
+
+# A adds a new list, B joins A's new list
+my $list = $A->list_add({ name => 'as new list', date => 0 });
+$B->list_join($list->{num});
+
+# A should only see B's list that it never joined
+my $other = $A->lists_get_other();
+ok(scalar(@$other), 1);
diff --git a/server/t/header.t b/server/t/header.t
@@ -0,0 +1,33 @@
+use strict;
+use Test;
+
+# XXX: This test isn't very good
+# - needs to check that server disconnects on these messages
+BEGIN { plan tests => 1 }
+
+use SL;
+
+# Need a new connection every time because server disconnects on header errors.
+my $server = SL::Server->new();
+
+# Invalid message number
+my $client = SL::Client->new(1);
+$client->send_all(pack('nnn', 0, 47837, 0), 6);
+
+# Bad protocol version
+$client = SL::Client->new(1);
+$client->send_all(pack('nnn', 101, 0, 0), 6);
+
+# Payload length that's too long
+$client = SL::Client->new(1);
+$client->send_all(pack('nnn', 0, 0, 25143), 6);
+
+# Advertised payload length longer than actual data length
+$client = SL::Client->new(1);
+$client->send_all(pack('nnnZ*', 0, 0, 5, 'ab'), 9);
+
+# Truncated header
+$client = SL::Client->new(1);
+$client->send_all(pack('nn', 101, 69), 4);
+
+ok(1);
diff --git a/server/t/invalid_deviceid.t b/server/t/invalid_deviceid.t
@@ -0,0 +1,45 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 42 }
+
+use SL;
+
+# Test that sending invalid device id's results in errors
+my $server = SL::Server->new();
+
+# Don't register
+my $A = SL::Client->new(1);
+
+my @device_ids = ('' , 'somebull$hit', 'legit');
+my @good_msgs = ('the client sent a device id that was not base64',
+ 'the client sent a device id that was not base64',
+ 'the client sent an unknown device id'
+);
+
+for (0..2) {
+ $A->set_device_id($device_ids[$_]);
+
+ # for messages that send 2 arguments, send an empty 2nd argument
+ my $err = $A->friend_add('', 'err');
+ ok( $err, $good_msgs[$_] );
+
+ $err = $A->friend_delete('', 'err');
+ ok( $err, $good_msgs[$_] );
+
+ $err = $A->list_add('', 'err');
+ ok( $err, $good_msgs[$_] );
+
+ $err = $A->list_join('', 'err');
+ ok( $good_msgs[$_], $err );
+
+ $err = $A->list_leave('', 'err');
+ ok( $good_msgs[$_], $err );
+
+ # messages that send 1 argument
+ $err = $A->lists_get('err');
+ ok( $good_msgs[$_], $err );
+
+ $err = $A->lists_get_other('err');
+ ok( $good_msgs[$_], $err );
+}
diff --git a/server/t/large_response.t b/server/t/large_response.t
@@ -0,0 +1,27 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 14 }
+
+use SL;
+
+# XXX: Test is broken
+# - for some reason sending more than 5 list_add's in a row screws something up
+# - lists_get() also seems to choke sometimes
+# - causes unknown
+
+# Test that large responses > 16384 bytes work as the underlying ssl layer can
+# only handle that much data at a time
+my $s = SL::Server->new();
+
+my $A = SL::Client->new();
+$A->list_add({ name => "$_" x 1000, date => 0}) for (1..5);
+
+# The response to this lists_get request clocks in at ~24 KB
+my $count = 0;
+for my $list (@{ $A->lists_get() }) {
+ $count += 1;
+ ok("$count" x 1000, $list->{name});
+}
+
+ok($count, 5);
diff --git a/server/t/leave_list_your_not_in.t b/server/t/leave_list_your_not_in.t
@@ -0,0 +1,19 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 7 }
+
+use SL;
+
+# Send a leave_list message that contains a valid list id but the requesting
+# device is not currently a member of.
+my $server = SL::Server->new();
+
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+my $list = $A->list_add({ name => 'only a can see this list', date => 0 });
+
+# Who knows how B got this list id, but he did
+my $err = $B->list_leave($list->{num}, 'err');
+ok($err, 'the client was not a member of the list');
diff --git a/server/t/list_add.t b/server/t/list_add.t
@@ -0,0 +1,24 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 10 }
+
+use SL;
+use Scalar::Util qw(looks_like_number);
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# make sure normal list_add works
+my $name = 'this is a new list';
+my $list = $A->list_add({ name => $name, date => 0 });
+
+ok(looks_like_number($list->{num}));
+ok($list->{name}, $name);
+ok($list->{num_members}, 1);
+ok($list->{members}->[0], $A->phnum());
+
+# verify a new_list request with an empty list name succeeds
+$A->list_add({ name => '', date => 0 });
+
+ok(scalar( @{ $A->lists_get() } ), 2);
diff --git a/server/t/list_join.t b/server/t/list_join.t
@@ -0,0 +1,35 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 18 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+# make A and B mutual friends
+$A->friend_add($B->phnum());
+$B->friend_add($A->phnum());
+
+# A creates a new list
+my $list_name = "this is a new list";
+my $As_list = $A->list_add({ name => $list_name, date => 0 });
+
+# B joins A's list
+my $list = $B->list_join($As_list->{num});
+ok( $list->{num}, $As_list->{num} );
+ok( $list->{name}, 'this is a new list' );
+ok( $list->{date}, 0 );
+ok( $list->{items_complete}, 0 );
+ok( $list->{items_total}, 0 );
+ok( $list->{num_members}, 2 );
+
+# B requests its lists to make sure its committed to the list
+($list) = @{ $B->lists_get() };
+
+# Verify what we get from server
+for ('num', 'name', 'date') {
+ ok( $As_list->{$_}, $list->{$_} );
+}
diff --git a/server/t/list_join_unit.t b/server/t/list_join_unit.t
@@ -0,0 +1,18 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 7 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# Try joining a list that doesn't exist
+my $err = $A->list_join('12345678', 'err');
+ok($err, 'the client sent an unknown list number');
+
+# Test joining a list your already in
+my $list = $A->list_add({ name => 'my new test list', date => 0 });
+$err = $A->list_join($list->{num}, 'err');
+ok($err, 'the device is already part of this list');
diff --git a/server/t/list_leave.t b/server/t/list_leave.t
@@ -0,0 +1,16 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 8 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+my $list = $A->list_add({ name => 'this list was made for leaving', date => 0 });
+$A->list_leave($list->{num});
+
+# verify we don't get this list back when requesting all lists
+ok( scalar( @{ $A->lists_get() } ), 0 );
+ok( scalar(@{ $A->lists_get_other() }), 0 );
diff --git a/server/t/list_leave_unit.t b/server/t/list_leave_unit.t
@@ -0,0 +1,17 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 6 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# Try leaving a list your not in
+my $err = $A->list_leave('1234567', 'err');
+ok($err, 'the client sent an unknown list number');
+
+# Try leaving the empty list
+$err = $A->list_leave('', 'err');
+ok($err, 'the client sent a list number that was not a number');
diff --git a/server/t/list_reference_counting.t b/server/t/list_reference_counting.t
@@ -0,0 +1,29 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 10 }
+
+use SL;
+
+# Test list reference counting to make sure they stay alive when needed
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+# A creates a new list
+my $list = $A->list_add({ name => 'this list will belong to B soon enough', date => 0 });
+
+# XXX: missing steps
+# - A and B become mutual friends
+# - B requests his other lists
+# - B joins A's list
+
+# B joins A's list, A leaves its own list
+$B->list_join($list->{num});
+$A->list_leave($list->{num});
+
+# B verifies its still in the list
+ok( scalar(@{ $B->lists_get() }), 1 );
+
+# B also leaves the list
+$B->list_leave($list->{num});
diff --git a/server/t/list_update.t b/server/t/list_update.t
@@ -0,0 +1,43 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 19 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# Test sending a request with no 'num' key
+my $err = $A->list_update({ name => 'some name' }, 'err');
+ok( $err, 'the client did not send a list number' );
+
+# Try and update a list that doesn't exist
+$err = $A->list_update({ num => 123456, name => 'some name' }, 'err');
+ok( $err, 'the client sent an unknown list number' );
+
+# All checks after this require a valid list, create one now
+my $list = $A->list_add({ name => 'this is a new list', date => 0 });
+
+# Update only the list name first
+$A->list_update({ num => $list->{num}, name => 'this is an updated name' });
+
+# Verify the name change persisted
+my @lists = @{ $A->lists_get() };
+ok( $lists[0]->{name}, 'this is an updated name' ) ;
+ok( $lists[0]->{date}, 0 );
+
+# Update only the date
+$A->list_update({ num => $list->{num}, date => 12345 });
+
+# Verify the date change persisted
+@lists = @{ $A->lists_get() };
+ok( $lists[0]->{name}, 'this is an updated name' );
+ok( $lists[0]->{date}, 12345 );
+
+# Now update both the name and date
+$A->list_update({ num => $list->{num}, date => 54321, name => 'updated again' });
+
+@lists = @{ $A->lists_get() };
+ok( $lists[0]->{name}, 'updated again' );
+ok( $lists[0]->{date}, 54321 );
diff --git a/server/t/lists_get.t b/server/t/lists_get.t
@@ -0,0 +1,32 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 28 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# Create 3 new lists
+my @stored_lists;
+for ('new list 1', 'new list 2', 'new list 3') {
+ push @stored_lists, $A->list_add({ name => $_, date => 0 });
+}
+
+my $i = 0;
+# Verify the information from lists_get matches what we know is true
+for my $list (@{ $A->lists_get() }) {
+ my $num = $list->{num};
+ my $stored_list = $stored_lists[$i];
+
+ ok( $list->{num}, $stored_list->{num} );
+ ok( $list->{num_members}, $stored_list->{num_members} );
+ ok( $list->{members}->[0], $A->phnum );
+ ok( $list->{name}, $stored_list->{name} );
+ ok( $list->{date}, $stored_list->{date} );
+ ok( $list->{items_total}, 0 );
+ ok( $list->{items_complete}, 0 );
+ $i++;
+}
+ok( $i, 3 );
diff --git a/server/t/lists_get_other.t b/server/t/lists_get_other.t
@@ -0,0 +1,26 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 13 }
+
+use SL;
+
+# Create A and B
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+# A and B become mutual friends
+$A->friend_add($B->phnum());
+$B->friend_add($A->phnum());
+
+# A adds a new list
+my $as_list = $A->list_add({ name => 'this is a new list that B can see', date => 0 });
+
+# Check that B can see As list
+my @other_lists = @{ $B->lists_get_other() };
+ok( $other_lists[0]->{name}, $as_list->{'name'} );
+ok( $other_lists[0]->{num}, $as_list->{'num'} );
+ok( $other_lists[0]->{num_members}, 1 );
+ok( $other_lists[0]->{members}->[0], $A->phnum() );
+ok( scalar(@other_lists), 1 );
diff --git a/server/t/multiple_friends_same_other_list.t b/server/t/multiple_friends_same_other_list.t
@@ -0,0 +1,36 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 19 }
+
+use SL;
+
+# 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 = SL::Server->new();
+
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+my $C = SL::Client->new();
+
+# A and B are mutual friends
+$A->friend_add($B->phnum());
+$B->friend_add($A->phnum());
+
+# A and C are also mutual friends
+$A->friend_add($C->phnum());
+$C->friend_add($A->phnum());
+
+# B and C need to be in the same list
+my $list = $B->list_add({ name => 'this is Bs new list', date => 0 });
+$C->list_join($list->{num});
+
+# A makes sure he got a single list
+my @other = @{ $A->lists_get_other() };
+ok( $other[0]->{num_members}, 2 );
+ok( $other[0]->{num}, $list->{num} );
+ok( scalar(@other), 1 );
+ok( ! grep {$_ eq $A->phnum()} @{$other[0]->{members}} );
+ok( grep {$_ eq $B->phnum()} @{$other[0]->{members}} );
+ok( grep {$_ eq $C->phnum()} @{$other[0]->{members}} );
diff --git a/server/t/no_ssl_fails.t b/server/t/no_ssl_fails.t
@@ -0,0 +1,28 @@
+use strict;
+use Test::More tests => 2;
+
+use_ok( 'SL' );
+use IO::Socket::INET;
+use Time::HiRes qw(usleep);
+
+# Check that a non-ssl connection isn't accepted
+
+my $server = SL::Server->new();
+
+my $socket = undef;
+while (!defined $socket) {
+ $socket = new IO::Socket::INET(
+ PeerHost => 'localhost',
+ PeerPort => 4729,
+ );
+ usleep(100 * 1000);
+}
+
+my $good_errno = 'Illegal seek';
+$socket->syswrite("a\0\0\0" x 787);
+#my $ret = $socket->sysread(my $buf, 6);
+ok(1);
+#fail "expected errno '$good_errno' but got '$!'" if ($! ne $good_errno);
+#fail "sysread returned '$ret', expected '0'" if ($ret != 0);
+
+#print STDERR $server->readline();
diff --git a/server/t/response_too_large.t_ b/server/t/response_too_large.t_
@@ -0,0 +1,13 @@
+#!/usr/bin/perl -I../
+use strict;
+use warnings;
+use client;
+use test;
+
+# Test that a message greater than 65KB doesn't get sent
+
+my $A = client->new();
+$A->list_add({ name => $_, date => 0 }) for (1..600);
+
+my $err = $A->lists_get('err');
+fail_msg_ne 'response too large', $err;
diff --git a/server/t/two_lists_same_name.t b/server/t/two_lists_same_name.t
@@ -0,0 +1,18 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 6 }
+
+use SL;
+
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# check that adding the same list twice works
+my $name = 'some list thats going to be added twice';
+$A->list_add({ name => $name, date => 0 });
+$A->list_add({ name => $name, date => 0 });
+
+my $num_lists = scalar(@{ $A->lists_get() });
+ok( $num_lists, 2 );
+# XXX: add validation this gives back 2 independent lists
diff --git a/server/t/update_list_youre_not_in.t b/server/t/update_list_youre_not_in.t
@@ -0,0 +1,19 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 7 }
+
+use SL;
+my $s = SL::Server->new();
+
+# Create A and B
+my $A = SL::Client->new();
+my $B = SL::Client->new();
+
+# A adds a new list
+my $list = $A->list_add({ name => 'this is a new list for a', date => 0 });
+
+# B tries to update A's list without joining it first
+my $request = { num => $list->{num}, name => 'some new name', date => 1 };
+my $err = $B->list_update($request, 'err');
+ok($err, 'client tried to update a list it was not in');
diff --git a/server/t/utf8.t b/server/t/utf8.t
@@ -0,0 +1,18 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 5 }
+
+use SL;
+my $s = SL::Server->new();
+my $A = SL::Client->new();
+
+# Create a new list with a name composed of 3 valid Unicode characters
+# - a left double quotation mark and
+# - ae sorta character thing but where they touch
+# - face with medical mask
+$A->list_add({ name => "\xE2\x80\x9C \xC3\xA6 \xF0\x9F\x98\xB8", date => 0 });
+my ($list) = @{ $A->lists_get() };
+
+# Check the list name we get back hasn't been mangled in the round trip
+ok( "\xE2\x80\x9C \xC3\xA6 \xF0\x9F\x98\xB8", $list->{name} );
diff --git a/server/t/zero_payload.t b/server/t/zero_payload.t
@@ -0,0 +1,23 @@
+use strict;
+use Test;
+
+BEGIN { plan tests => 12 }
+
+use SL;
+
+# Create new device, turn off automatic device_add
+my $s = SL::Server->new();
+my $A = SL::Client->new(1);
+
+# Send size zero payload to all message types
+for ( $A->msg_str() ) {
+ my $msg_good = 'a missing message argument was required';
+ if ($_ eq 'device_add') {
+ $msg_good = 'the sent phone number is not a number';
+ }
+
+ # Send empty dictionary
+ $A->send_msg($_, {} );
+ my $response = $A->recv_msg($_);
+ ok( $response->{reason}, $msg_good );
+}
diff --git a/server/test.pl b/server/test.pl
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+use TAP::Harness;
+use Getopt::Std;
+
+my %args;
+getopt("c", \%args);
+
+my $harness = TAP::Harness->new({ color => 1 });
+$harness->runtests(glob("t/*.t"));
