commit 5437846c47fd4d6520880868ee0d94180ad7ed0e parent d7ce548f5b130f49d6aee4c66fdbfca06f1c793f Author: Kyle Milz <kyle@0x30.net> Date: Sat, 27 Feb 2016 12:13:56 -0700 server: nuke old test harness + tests Diffstat:
89 files changed, 0 insertions(+), 1172 deletions(-)
diff --git a/server/coverage.sh b/server/coverage.sh @@ -1,45 +0,0 @@ -#!/bin/sh - -# Try not to connect to a production instance with this script! -export PORT=5899 - -if [ `uname` = "OpenBSD" ]; then - alias make=gmake -fi - -# Start server with Devel::Cover module loaded -perl -MDevel::Cover sl -p $PORT -t & -server_pid=$! - -perl testd.pl & -testd_pid=$! - -passed=0 -failed=0 -count=0 -for t in `ls t/*/Makefile`; do - count=`expr $count + 1` - test_dir=`dirname ${t}` - - if ! make -s -C $test_dir test; then - printf ">>> %3s %s: test failed\n" $count $test_dir - failed=`expr $failed + 1` - continue - fi - - printf ">>> %3s %s: ok\n" $count $test_dir - passed=`expr $passed + 1` -done - -# Kill the server to flush all coverage data -kill $testd_pid -kill $server_pid -wait - -sleep 1 - -printf ">>> %i ok %i failed " $passed $failed -printf "(%i min %i sec)\n" $((SECONDS / 60)) $((SECONDS % 60)) - -# Run Devel::Cover tool to post process coverage data -cover diff --git a/server/run_tests.sh b/server/run_tests.sh @@ -1,66 +0,0 @@ -#!/bin/sh - -# Try not to connect to the production server with this script! -export PORT=4729 - -if which tput > /dev/null; then - red=`tput setaf 1 0 0` - green=`tput setaf 2 0 0` - reset=`tput sgr0` -fi - -if [ `uname` = "OpenBSD" ]; then - alias make=gmake -fi - -perl -T sl -p $PORT -t > server.log & -server_pid=$! - -perl testd.pl > testd.log & -testd_pid=$! - -ok=0 -test_failed=0 -diff_failed=0 -count=0 -for t in `LC_ALL=C ls t/*/Makefile`; do - count=`expr $count + 1` - test_dir=`dirname ${t}` - > server.log - > testd.log - - # run test, complain if it failed - if ! make -s -C $test_dir test; then - printf "%3s %s: $red%s$reset\n" $count $test_dir "test failed" - test_failed=$((test_failed + 1)) - > server.log - > testd.log - continue - fi - - # copy server log aside for diff'ing - cp server.log $test_dir/server.log - cp testd.log $test_dir/testd.log - - # diff the server's output log - if ! make -s -C $test_dir diff; then - printf "%3s %s: $red%s$reset\n" $count $test_dir "diff failed" - diff_failed=$((diff_failed + 1)) - continue - fi - - make -s -C $test_dir clean - printf "%3s %s: $green%s$reset\n" $count $test_dir "ok" - ok=$((ok + 1)) -done - -kill $testd_pid -kill $server_pid -wait 2>/dev/null -rm testd.log -rm server.log - -printf "\n%i ok, %i test + %i diff fail " $ok $test_failed $diff_failed -printf "(%i min %i sec)\n" $((SECONDS / 60)) $((SECONDS % 60)) - -exit $failed; diff --git a/server/t/_server_listening/Makefile b/server/t/_server_listening/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=none - -include ../test.mk diff --git a/server/t/_server_listening/test.pl b/server/t/_server_listening/test.pl @@ -1,35 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; - -use IO::Socket::INET; -use Time::HiRes qw(usleep); -use test; - -# Wait until a successful connection can be made, or timeout. -# This must be the first test because other tests do not have connection -# retries and will assume that a connectible server is up and ready. - -my $socket; -my $timeout = time + 3; -while (1) { - $socket = new IO::Socket::INET( - PeerHost => 'localhost', - PeerPort => $ENV{PORT} || 5437, - ); - - # Connection refused, ie server has not called listen() yet - if ($!{ECONNREFUSED}) { - fail "server not ready after 3 seconds" if (time > $timeout); - usleep(100 * 1000); - - next; - } - - # We got some non Connection refused return code - last; -} - -fail "socket not good" unless ($socket); -$socket->syswrite("a\0\0\0"x 3); -$socket->sysread(my $buf, 1); diff --git a/server/t/bad_payloads/Makefile b/server/t/bad_payloads/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/bad_payloads/test.pl b/server/t/bad_payloads/test.pl @@ -1,12 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; - -# Send a straight up unparsable json string -my $client = 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 = client->new(1); -$client->send_all(pack('nnnZ*', 0, 0, 2, "[]"), 9); diff --git a/server/t/client.pm b/server/t/client.pm @@ -1,216 +0,0 @@ -package client; -use strict; -use warnings; - -use Carp; -use IO::Socket::SSL; -use JSON::XS; -use Try::Tiny; -use test; - -require "msgs.pl"; -our (%msg_num, @msg_str); - -sub new { - my $class = shift; - my $dont_register = shift || 0; - - my $self = {}; - bless ($self, $class); - - $self->{sock} = IO::Socket::SSL->new( - PeerHost => 'localhost', - PeerPort => $ENV{PORT} || 5437, - # this is needed because PeerHost is localhost and our SSL - # certificates are signed with absentmindedproductions.ca - SSL_verifycn_name => "absentmindedproductions.ca", - ); - unless ($self->{sock}) { - die "failed connect or ssl handshake: $!,$SSL_ERROR"; - } - - $self->{device_id} = undef; - - if ($dont_register == 0) { - $self->{phnum} = rand_phnum(); - - 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}; - confess "wrong message status '$status'" if ($status ne $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; -} - -1; diff --git a/server/t/device_add/Makefile b/server/t/device_add/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/device_add/test.pl b/server/t/device_add/test.pl @@ -1,29 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); - -# Constructor automatically calls device_add so no need to do it here -my $devid = $A->device_id(); -my $length = length($devid); -fail "device id '$devid' not base64" unless ($devid =~ m/^[a-zA-Z0-9+\/=]+$/); -fail "expected device id length of 43, got $length" if ($length != 43); - -# Duplicate phone number -my $err = $A->device_add({ phone_number => $A->phnum, os => 'unix' }, 'err'); -fail_msg_ne 'the sent phone number already exists', $err; - -# Bad phone number -$err = $A->device_add({ phone_number => '403867530&', os => 'unix' }, 'err'); -fail_msg_ne 'the sent phone number is not a number', $err; - -# Bad operating system -$err = $A->device_add({ phone_number => rand_phnum(), os => 'bados' }, 'err'); -fail_msg_ne 'operating system not supported', $err; - -# Good operating systems -$A->device_add({ phone_number => rand_phnum(), os => 'android' }); -$A->device_add({ phone_number => rand_phnum(), os => 'ios' }); diff --git a/server/t/device_update/Makefile b/server/t/device_update/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/device_update/test.pl b/server/t/device_update/test.pl @@ -1,7 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; - -my $A = client->new(); -$A->device_update({ pushtoken_hex => "AD34A9EF72DC714CED" }); diff --git a/server/t/bad_payloads/server.log.good b/server/t/exp_output/bad_payloads.server.log diff --git a/server/t/device_add/server.log.good b/server/t/exp_output/device_add.server.log diff --git a/server/t/device_update/server.log.good b/server/t/exp_output/device_update.server.log diff --git a/server/t/friend_add/server.log.good b/server/t/exp_output/friend_add.server.log diff --git a/server/t/friend_delete/server.log.good b/server/t/exp_output/friend_delete.server.log diff --git a/server/t/friend_delete_unit/server.log.good b/server/t/exp_output/friend_delete_unit.server.log diff --git a/server/t/get_other_lists_filters_my_lists/server.log.good b/server/t/exp_output/get_other_lists_filters_my_lists.server.log diff --git a/server/t/header/server.log.good b/server/t/exp_output/header.server.log diff --git a/server/t/invalid_deviceid/server.log.good b/server/t/exp_output/invalid_deviceid.server.log diff --git a/server/t/leave_list_your_not_in/server.log.good b/server/t/exp_output/leave_list_your_not_in.server.log diff --git a/server/t/list_add/server.log.good b/server/t/exp_output/list_add.server.log diff --git a/server/t/list_join/server.log.good b/server/t/exp_output/list_join.server.log diff --git a/server/t/list_join_unit/server.log.good b/server/t/exp_output/list_join_unit.server.log diff --git a/server/t/list_leave/server.log.good b/server/t/exp_output/list_leave.server.log diff --git a/server/t/list_leave_unit/server.log.good b/server/t/exp_output/list_leave_unit.server.log diff --git a/server/t/list_reference_counting/server.log.good b/server/t/exp_output/list_reference_counting.server.log diff --git a/server/t/list_update/server.log.good b/server/t/exp_output/list_update.server.log diff --git a/server/t/lists_get/server.log.good b/server/t/exp_output/lists_get.server.log diff --git a/server/t/lists_get_other/server.log.good b/server/t/exp_output/lists_get_other.server.log diff --git a/server/t/multiple_friends_same_other_list/server.log.good b/server/t/exp_output/multiple_friends_same_other_list.server.log diff --git a/server/t/two_lists_same_name/server.log.good b/server/t/exp_output/two_lists_same_name.server.log diff --git a/server/t/update_list_youre_not_in/server.log.good b/server/t/exp_output/update_list_youre_not_in.server.log diff --git a/server/t/utf8/server.log.good b/server/t/exp_output/utf8.server.log diff --git a/server/t/zero_payload/server.log.good b/server/t/exp_output/zero_payload.server.log diff --git a/server/t/friend_add/Makefile b/server/t/friend_add/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/friend_add/test.pl b/server/t/friend_add/test.pl @@ -1,25 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = 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'); -fail_msg_ne 'friends phone number is not a valid phone number', $err; - -# Empty phone number -$err = $A->friend_add('', 'err'); -fail_msg_ne 'friends phone number is not a valid phone number', $err; - -# Friending yourself -$err = $A->friend_add($A->phnum(), 'err'); -fail_msg_ne 'device cannot add itself as a friend', $err; diff --git a/server/t/friend_delete/Makefile b/server/t/friend_delete/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=sort - -include ../test.mk diff --git a/server/t/friend_delete/test.pl b/server/t/friend_delete/test.pl @@ -1,38 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); -my $B = 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 -my $A_other_lists = scalar @{ $A->lists_get_other() }; -my $B_other_lists = scalar @{ $B->lists_get_other() }; -fail "expected A to have 0 other lists" if ($A_other_lists != 0); -fail "expected B to have 0 other lists" if ($B_other_lists != 0); - -my $A_num_lists = scalar @{ $A->lists_get() }; -my $B_num_lists = scalar @{ $B->lists_get() }; -fail "expected A to have 2 lists" if ($A_num_lists != 2); -fail "expected B to have 2 lists" if ($B_num_lists != 2); diff --git a/server/t/friend_delete_unit/Makefile b/server/t/friend_delete_unit/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/friend_delete_unit/test.pl b/server/t/friend_delete_unit/test.pl @@ -1,23 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); - -# Someone who is not your friend -my $err = $A->friend_delete('12345', 'err'); -fail_msg_ne 'friend sent for deletion was not a friend', $err; - -# Non numeric friends phone number -$err = $A->friend_delete('asdf123', 'err'); -fail_msg_ne 'friends phone number is not a valid phone number', $err; - -# Empty phone number -$err = $A->friend_delete('', 'err'); -fail_msg_ne 'friends phone number is not a valid phone number', $err; - -# Add/delete cycle works -$A->friend_add('12345'); -$A->friend_delete('12345'); diff --git a/server/t/get_other_lists_filters_my_lists/Makefile b/server/t/get_other_lists_filters_my_lists/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=sort - -include ../test.mk diff --git a/server/t/get_other_lists_filters_my_lists/test.pl b/server/t/get_other_lists_filters_my_lists/test.pl @@ -1,27 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# 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 - -# Create A and B -my $A = client->new(); -my $B = 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(); -fail_num_ne 'wrong number of other lists ', scalar(@$other), 1; diff --git a/server/t/header/Makefile b/server/t/header/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/header/test.pl b/server/t/header/test.pl @@ -1,26 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; - -# Need a new connection every time because server disconnects on header errors. - -# Invalid message number -my $client = client->new(1); -$client->send_all(pack('nnn', 0, 47837, 0), 6); - -# Bad protocol version -$client = client->new(1); -$client->send_all(pack('nnn', 101, 0, 0), 6); - -# Payload length that's too long -$client = client->new(1); -$client->send_all(pack('nnn', 0, 0, 25143), 6); - -# Advertised payload length longer than actual data length -$client = client->new(1); -$client->send_all(pack('nnnZ*', 0, 0, 5, 'ab'), 9); - -# Truncated header -$client = client->new(1); -$client->send_all(pack('nn', 101, 69), 4); diff --git a/server/t/invalid_deviceid/Makefile b/server/t/invalid_deviceid/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/invalid_deviceid/test.pl b/server/t/invalid_deviceid/test.pl @@ -1,43 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# test that sending invalid device id's results in errors - -# Don't register -my $A = 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'); - fail_msg_ne $good_msgs[$_], $err; - - $err = $A->friend_delete('', 'err'); - fail_msg_ne $good_msgs[$_], $err; - - $err = $A->list_add('', 'err'); - fail_msg_ne $good_msgs[$_], $err; - - $err = $A->list_join('', 'err'); - fail_msg_ne $good_msgs[$_], $err; - - $err = $A->list_leave('', 'err'); - fail_msg_ne $good_msgs[$_], $err; - - # messages that send 1 argument - $err = $A->lists_get('err'); - fail_msg_ne $good_msgs[$_], $err; - - $err = $A->lists_get_other('err'); - fail_msg_ne $good_msgs[$_], $err; -} diff --git a/server/t/large_response/Makefile b/server/t/large_response/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=none - -include ../test.mk diff --git a/server/t/large_response/test.pl b/server/t/large_response/test.pl @@ -1,19 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# Test that large responses > 16384 bytes work as the underlying ssl layer can -# only handle that much data at a time - -my $A = client->new(); -$A->list_add({ name => $_, date => 0}) for (1..200); - -# The response to this lists_get request clocks in at ~24 KB -my $count = 0; -for my $list (@{ $A->lists_get() }) { - $count += 1; - fail_msg_ne "$count", $list->{name}; -} -fail_num_ne 'total lists different', $count, 200; diff --git a/server/t/leave_list_your_not_in/Makefile b/server/t/leave_list_your_not_in/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/leave_list_your_not_in/test.pl b/server/t/leave_list_your_not_in/test.pl @@ -1,17 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# Send a leave_list message that contains a valid list id but the requesting -# device is not currently a member of. - -my $A = client->new(); -my $B = 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'); -fail_msg_ne 'the client was not a member of the list', $err; diff --git a/server/t/list_add/Makefile b/server/t/list_add/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/list_add/test.pl b/server/t/list_add/test.pl @@ -1,23 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; -use Scalar::Util qw(looks_like_number); - -my $A = client->new(); - -# make sure normal list_add works -my $name = 'this is a new list'; -my $list = $A->list_add({ name => $name, date => 0 }); - -fail "list num isn't numeric" unless (looks_like_number($list->{num})); -fail_msg_ne $name, $list->{name}; -fail_num_ne "wrong number of members", $list->{num_members}, 1; -fail_msg_ne $list->{members}->[0], $A->phnum(); - -# verify a new_list request with an empty list name succeeds -$A->list_add({ name => '', date => 0 }); - -my $num_lists = scalar( @{ $A->lists_get() } ); -fail_num_ne "wrong number of lists", $num_lists, 2; diff --git a/server/t/list_join/Makefile b/server/t/list_join/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=sort - -include ../test.mk diff --git a/server/t/list_join/test.pl b/server/t/list_join/test.pl @@ -1,33 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); -my $B = 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}); -fail_num_ne 'list num mismatch', $list->{num}, $As_list->{num}; -fail_msg_ne 'this is a new list', $list->{name}; -fail_num_ne 'date mismatch', $list->{date}, 0; -fail_num_ne 'items complete mismatch', $list->{items_complete}, 0; -fail_num_ne 'items total mismatch', $list->{items_total}, 0; -fail_num_ne 'num members mismatch', $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') { - fail_msg_ne $As_list->{$_}, $list->{$_}; -} diff --git a/server/t/list_join_unit/Makefile b/server/t/list_join_unit/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/list_join_unit/test.pl b/server/t/list_join_unit/test.pl @@ -1,16 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); - -# Try joining a list that doesn't exist -my $err = $A->list_join('12345678', 'err'); -fail_msg_ne 'the client sent an unknown list number', $err; - -# 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'); -fail_msg_ne 'the device is already part of this list', $err; diff --git a/server/t/list_leave/Makefile b/server/t/list_leave/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/list_leave/test.pl b/server/t/list_leave/test.pl @@ -1,17 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = 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 -my $num_lists = scalar( @{ $A->lists_get() } ); -my $num_other_lists = scalar(@{ $A->lists_get_other() }); - -fail_num_ne 'wrong number of lists ',$num_lists, 0; -fail_num_ne 'wrong number of other lists ', $num_other_lists, 0; diff --git a/server/t/list_leave_unit/Makefile b/server/t/list_leave_unit/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/list_leave_unit/test.pl b/server/t/list_leave_unit/test.pl @@ -1,15 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); - -# Try leaving a list your not in -my $err = $A->list_leave('1234567', 'err'); -fail_msg_ne 'the client sent an unknown list number', $err; - -# Try leaving the empty list -$err = $A->list_leave('', 'err'); -fail_msg_ne 'the client sent a list number that was not a number', $err; diff --git a/server/t/list_reference_counting/Makefile b/server/t/list_reference_counting/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=sort - -include ../test.mk diff --git a/server/t/list_reference_counting/test.pl b/server/t/list_reference_counting/test.pl @@ -1,28 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# Test list reference counting to make sure they stay alive when needed -my $A = client->new(); -my $B = 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 -my $num_lists = scalar(@{ $B->lists_get() }); -fail_num_ne 'wrong number of lists ', $num_lists, 1; - -# B also leaves the list -$B->list_leave($list->{num}); diff --git a/server/t/list_update/Makefile b/server/t/list_update/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/list_update/test.pl b/server/t/list_update/test.pl @@ -1,41 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); - -# Test sending a request with no 'num' key -my $err = $A->list_update({ name => 'some name' }, 'err'); -fail_msg_ne 'the client did not send a list number', $err; - -# Try and update a list that doesn't exist -$err = $A->list_update({ num => 123456, name => 'some name' }, 'err'); -fail_msg_ne 'the client sent an unknown list number', $err; - -# 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() }; -fail_msg_ne 'this is an updated name', $lists[0]->{name}; -fail_num_ne 'date mismatch', $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() }; -fail_msg_ne $lists[0]->{name}, 'this is an updated name'; -fail_num_ne 'date mismatch', $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() }; -fail_msg_ne $lists[0]->{name}, 'updated again'; -fail_num_ne 'date mismatch', $lists[0]->{date}, 54321; diff --git a/server/t/lists_get/Makefile b/server/t/lists_get/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/lists_get/test.pl b/server/t/lists_get/test.pl @@ -1,30 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = 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]; - - fail_msg_ne $list->{num}, $stored_list->{num}; - fail_num_ne 'wrong number of members', $list->{num_members}, $stored_list->{num_members}; - fail_msg_ne $A->phnum, $list->{members}->[0]; - fail_msg_ne $list->{name}, $stored_list->{name}; - fail_num_ne 'date not the same', $list->{date}, $stored_list->{date}; - fail_num_ne 'items total not the same', $list->{items_total}, 0; - fail_num_ne 'items complete not the same', $list->{items_complete}, 0; - $i++; -} -fail_num_ne 'wrong number of lists', $i, 3; diff --git a/server/t/lists_get_other/Makefile b/server/t/lists_get_other/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=sort - -include ../test.mk diff --git a/server/t/lists_get_other/test.pl b/server/t/lists_get_other/test.pl @@ -1,24 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# Create A and B -my $A = client->new(); -my $B = 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() }; -fail_msg_ne $other_lists[0]->{name}, $as_list->{'name'}; -fail_msg_ne $other_lists[0]->{num}, $as_list->{'num'}; -fail_num_ne 'wrong number of list members', $other_lists[0]->{num_members}, 1; -fail_msg_ne $other_lists[0]->{members}->[0], $A->phnum(); -fail_num_ne 'wrong number of other lists', scalar(@other_lists), 1; diff --git a/server/t/msgs.pl b/server/t/msgs.pl @@ -1,48 +0,0 @@ -#!/usr/bin/perl -# generated Sat Feb 20 15:18:31 MST 2016 -use strict; -use warnings; - -our $protocol_ver = 0; -our %msg_num = ( - device_add => 0, - device_update => 1, - friend_add => 2, - friend_delete => 3, - list_add => 4, - list_update => 5, - list_join => 6, - list_leave => 7, - lists_get => 8, - lists_get_other => 9, - list_items_get => 10, - list_item_add => 11, -); -our @msg_str = ( - 'device_add', - 'device_update', - 'friend_add', - 'friend_delete', - 'list_add', - 'list_update', - 'list_join', - 'list_leave', - 'lists_get', - 'lists_get_other', - 'list_items_get', - 'list_item_add', -); -our @msg_func = ( - \&msg_device_add, - \&msg_device_update, - \&msg_friend_add, - \&msg_friend_delete, - \&msg_list_add, - \&msg_list_update, - \&msg_list_join, - \&msg_list_leave, - \&msg_lists_get, - \&msg_lists_get_other, - \&msg_list_items_get, - \&msg_list_item_add, -); diff --git a/server/t/multiple_friends_same_other_list/Makefile b/server/t/multiple_friends_same_other_list/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=sort - -include ../test.mk diff --git a/server/t/multiple_friends_same_other_list/test.pl b/server/t/multiple_friends_same_other_list/test.pl @@ -1,34 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use test; -use client; - -# 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 $A = client->new(); -my $B = client->new(); -my $C = 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() }; -fail_num_ne 'wrong number of list members', $other[0]->{num_members}, 2; -fail_msg_ne $other[0]->{num}, $list->{num}; -fail_num_ne 'wrong number of lists', scalar(@other), 1; -fail "A found unexpectedly" if (grep {$_ eq $A->phnum()} @{$other[0]->{members}}); -fail "member B not found" unless (grep {$_ eq $B->phnum()} @{$other[0]->{members}}); -fail "member C not found" unless (grep {$_ eq $C->phnum()} @{$other[0]->{members}}); diff --git a/server/t/no_ssl_fails/Makefile b/server/t/no_ssl_fails/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=os - -include ../test.mk diff --git a/server/t/no_ssl_fails/server.log.good.Linux b/server/t/no_ssl_fails/server.log.good.Linux @@ -1,2 +0,0 @@ -new connection (pid = <digits>) -error: SSL accept attempt failed with unknown error error:140760FC:SSL routines:SSL23_GET_CLIENT_HELLO:unknown protocol diff --git a/server/t/no_ssl_fails/server.log.good.OpenBSD b/server/t/no_ssl_fails/server.log.good.OpenBSD @@ -1,2 +0,0 @@ -new connection (pid = <digits>) -error: SSL accept attempt failed error:140760FC:SSL routines:SSL23_GET_CLIENT_HELLO:unknown protocol diff --git a/server/t/no_ssl_fails/test.pl b/server/t/no_ssl_fails/test.pl @@ -1,19 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; - -use IO::Socket::INET; -use Time::HiRes qw(usleep); -use test; - -# check that a non-ssl connection isn't accepted -my $socket = new IO::Socket::INET( - PeerHost => 'localhost', - PeerPort => $ENV{PORT} || 5437, -); - -my $good_errno = 'Illegal seek'; -$socket->syswrite("a\0\0\0" x 787); -my $ret = $socket->sysread(my $buf, 6); -#fail "expected errno '$good_errno' but got '$!'" if ($! ne $good_errno); -#fail "sysread returned '$ret', expected '0'" if ($ret != 0); diff --git a/server/t/response_too_large/Makefile b/server/t/response_too_large/Makefile @@ -1,3 +0,0 @@ -DIFF_MOD=none - -include ../test.mk diff --git a/server/t/response_too_large/test.pl b/server/t/response_too_large/test.pl @@ -1,13 +0,0 @@ -#!/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/test.mk b/server/t/test.mk @@ -1,32 +0,0 @@ -test: - perl test.pl - -process-server-log: - # remove header, phone numbers, base64 and strings from server.log - sed -i -e "s/.*> //" \ - -e "s/'[0-9]*'/<digits>/g" \ - -e "s/'[a-zA-Z0-9/+]*'/<base64>/g" \ - -e "s/'[a-zA-Z0-9 ]*'/<string>/g" \ - -e 's/[0-9]\.[0-9]\.[0-9]\.[0-9]:[0-9]*/<ip>:<port>/' \ - server.log - -ifeq ($(DIFF_MOD), none) -diff: - rm -f server.log - -else ifeq ($(DIFF_MOD), sort) -diff: process-server-log - LC_ALL=C sort -o server.log < server.log - diff -u server.log.good server.log - -else ifeq ($(DIFF_MOD), os) -diff: process-server-log - diff -u server.log.good.`uname` server.log - -else -diff: process-server-log - diff -u server.log.good server.log -endif - -clean: - rm -f server.log testd.log diff --git a/server/t/test.pm b/server/t/test.pm @@ -1,34 +0,0 @@ -package test; -use strict; -use warnings; - -use Carp; -use Exporter qw(import); -use String::Random; - -our @EXPORT = qw(rand_phnum fail fail_msg_ne fail_num_ne); - -my $string_gen = String::Random->new; -sub rand_phnum { - return '403' . $string_gen->randpattern('nnnnnnn'); -} - -sub fail { - confess shift; -} - -sub fail_msg_ne { - my ($arg1, $arg2) = @_; - return if ($arg1 eq $arg2); - - confess "expected string '$arg1' but got '$arg2'"; -} - -sub fail_num_ne { - my ($msg, $arg1, $arg2) = @_; - return if ($arg1 == $arg2); - - confess "$msg $arg1 != $arg2"; -} - -1; diff --git a/server/t/test.sh b/server/t/test.sh @@ -1,11 +0,0 @@ -#!/bin/sh - -if [ "$PORT" == "" ]; then - echo "PORT environment variable must be set!" - exit 1 -fi - -fail() { - echo -n "$1" - exit 1 -} diff --git a/server/t/two_lists_same_name/Makefile b/server/t/two_lists_same_name/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/two_lists_same_name/test.pl b/server/t/two_lists_same_name/test.pl @@ -1,16 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = 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() }); -fail_num_ne "wrong number of lists", $num_lists, 2; -# XXX: add validation this gives back 2 independent lists diff --git a/server/t/update_list_youre_not_in/Makefile b/server/t/update_list_youre_not_in/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/update_list_youre_not_in/test.pl b/server/t/update_list_youre_not_in/test.pl @@ -1,17 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -# Create A and B -my $A = client->new(); -my $B = 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'); -fail_msg_ne 'client tried to update a list it was not in', $err; diff --git a/server/t/utf8/Makefile b/server/t/utf8/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/utf8/test.pl b/server/t/utf8/test.pl @@ -1,17 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -my $A = client->new(); - -# Create a new list with a name composed of 3 parts: -# - 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 -fail_msg_ne "\xE2\x80\x9C \xC3\xA6 \xF0\x9F\x98\xB8", $list->{name}; diff --git a/server/t/zero_payload/Makefile b/server/t/zero_payload/Makefile @@ -1 +0,0 @@ -include ../test.mk diff --git a/server/t/zero_payload/test.pl b/server/t/zero_payload/test.pl @@ -1,24 +0,0 @@ -#!/usr/bin/perl -I../ -use strict; -use warnings; -use client; -use test; - -require '../msgs.pl'; -our (@msg_str); - -# Create new device, turn off automatic device_add -my $A = client->new(1); - -# Send size zero payload to all message types -for (@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($_); - fail_msg_ne $msg_good, $response->{reason}; -}