shlist

share and manage lists between multiple people
Log | Files | Refs

commit 2e1b3f18983c50082096e3d477a40f9c6c17a9d4
parent 5859685c2fa44a3ff1e72c26202eb04e7087b86d
Author: kyle <kyle@0x30.net>
Date:   Wed,  9 Dec 2015 20:54:02 -0700

sl: use ssl's sys{read,write} instead of read/write

- turns out perl read/write uses fread/fwrite under the hood
  - this probably wasn't optimal for sockets
- so use the sys{read,write} method provided from IO::Socket::SSL
- while here, stop passing the socket into the message handler functions
  - instead, have the message handlers return their responses
  - then move all socket handling to the main receive loop
  - this simplifies things quite a bit
- also start checking that we sysread an entire message, looping if needed

Diffstat:
Msl | 109++++++++++++++++++++++++++++++++++++++++++++++---------------------------------
1 file changed, 64 insertions(+), 45 deletions(-)

diff --git a/sl b/sl @@ -85,7 +85,7 @@ while (my $new_sock = $listen_sock->accept()) { last unless (defined $msg_type && defined $msg); $dbh->begin_work; - $msg_func[$msg_type]->($dbh, $stmt_handles, $new_sock, $msg); + my $reply = $msg_func[$msg_type]->($dbh, $stmt_handles, $msg); $dbh->commit; if ($@) { @@ -94,7 +94,12 @@ while (my $new_sock = $listen_sock->accept()) { # but do it in an eval{} as it may also fail eval { $dbh->rollback }; # XXX: are database errors fatal to this connection? + next; } + + # when message handlers have errors, don't send a reply + next unless defined $reply; + send_msg($new_sock, $msg_type, $reply); } $stmt_handles->{$_} = undef for (keys %$stmt_handles); @@ -107,16 +112,10 @@ print "got here\n"; # any header parsing errors or message read errors are fatal in this function sub recv_msg { - my ($new_sock) = (@_); + my ($sock) = (@_); - # message header is 4 bytes - my $bread = read $new_sock, my $header, 4; - if ($bread == 0) { - return undef; - } elsif ($bread != 4) { - log_print("error: read $bread instead of 4 bytes\n"); - return undef; - } + my $header = read_all($sock, 4); + return undef unless defined $header; my ($msg_type, $msg_size) = unpack("nn", $header); unless (defined $msg_type && defined $msg_size) { @@ -134,20 +133,43 @@ sub recv_msg { log_print("error: $msg_size byte message too large\n"); return undef; } - - # read the actual message - $bread = read($new_sock, my $msg, $msg_size); - if ($bread != $msg_size) { - if ($bread < $msg_size) { - log_print("msg read: read $bread instead of $msg_size bytes\n"); - return undef; - } - log_print("msg read: read $bread instead of $msg_size bytes\n"); + elsif ($msg_size == 0) { + # don't try and do another read, as a read of size 0 is EOF + return ($msg_type, ""); } + my $msg = read_all($sock, $msg_size); + return undef unless defined $msg; + return ($msg_type, $msg); } +sub read_all { + my ($sock, $bytes_total) = @_; + + my $bytes_read = $sock->sysread(my $data, $bytes_total); + if (!defined $bytes_read) { + log_print("error: read failed: $!\n"); + return undef; + } elsif ($bytes_read == 0) { + # log_print("error: read EOF\n"); + return undef; + } elsif ($bytes_read != $bytes_total) { + log_print("error: read $bytes_read instead of $bytes_total bytes\n"); + return undef; + } + + return $data; +} + +sub send_msg { + my ($socket, $msg_type, $msg) = (@_); + + my $n = $socket->syswrite(pack("nn", $msg_type, length($msg))); + $n += $socket->syswrite($msg); + return $n; +} + sub get_phone_number { my ($dbh, $sth, $device_id) = @_; @@ -165,7 +187,7 @@ sub get_phone_number sub msg_new_device { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; # single field @@ -185,15 +207,15 @@ sub msg_new_device # XXX: need to check the db to make sure this isn't duplicate my $token = sha256_base64(arc4random_bytes(32)); - print $new_sock pack("nn", $msg_num{new_device}, length($token)); - print $new_sock $token; $sth{new_device}->execute($token, $ph_num, time); log_print("new_device: success '$ph_num' '" .fingerprint($token). "'\n"); + + return $token; } sub msg_new_list { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; # expecting two fields delimited by null @@ -221,13 +243,14 @@ sub msg_new_list # XXX: also send back the date and all that stuff my $phone_number = get_phone_number($dbh, $sth_ref, $device_id); my $out = $list_id . "\0" . $list_name . "\0" . $phone_number; - print $new_sock pack("nn", $msg_num{new_list}, length($out)); - print $new_sock $out; + + return $out; } sub msg_new_list_item { my ($dbh, $sth_ref, $new_sock, $msg) = @_; + return undef; # my ($list_id, $position, $text) = split ("\0", $msg); @@ -245,7 +268,7 @@ sub msg_new_list_item sub msg_join_list { - my ($dbh, $sth_ref, $new_sock, $msg, $sth) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; my ($device_id, $list_id) = split("\0", $msg); @@ -264,13 +287,12 @@ sub msg_join_list log_print("join_list: tried to create a duplicate list member entry for device $device_id and list $list_id\n"); } - print $new_sock pack("nn", $msg_num{join_list}, length($list_id)); - print $new_sock $list_id; + return $list_id; } sub msg_leave_list { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; my ($device_id, $list_id) = split("\0", $msg); @@ -301,14 +323,14 @@ sub msg_leave_list $alive = 0; } my $out = "$list_id\0$alive"; - print $new_sock pack("nn", $msg_num{leave_list}, length($out)); - print $new_sock $out; + + return $out; } # update friend map sub msg_add_friend { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; # device id followed by 1 friends number @@ -343,9 +365,7 @@ sub msg_add_friend } } - my $out = "$friend"; - print $new_sock pack("nn", $msg_num{add_friend}, length($out)); - print $new_sock $out; + return $friend; } sub msg_delete_friend @@ -360,7 +380,7 @@ sub msg_delete_friend # get both lists the device is in, and lists it can see sub msg_list_request { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; return if (device_id_invalid($dbh, $sth_ref, $msg)); @@ -414,15 +434,14 @@ sub msg_list_request } $out .= join("\0", @indirect_lists); - print $new_sock pack("nn", $msg_num{list_request}, length($out)); - print $new_sock $out; + return $out; # XXX: add time of last request to list (rate throttling)? } sub msg_list_items { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; my %sth = %$sth_ref; my ($device_id, $list_id) = split("\0", $msg); @@ -451,19 +470,19 @@ sub msg_list_items } my $out = join("\0", @items); - print $new_sock pack("nn", $msg_num{list_items}, length($out)); - print $new_sock $out; + return $out; } sub msg_ok { - my ($dbh, $sth_ref, $new_sock, $msg) = @_; + my ($dbh, $sth_ref, $msg) = @_; return if (device_id_invalid($dbh, $sth_ref, $msg)); - # send message type 8, 0 bytes payload - print $new_sock pack("nn", $msg_num{ok}, 1); - print $new_sock '!'; + log_print("ok: device '" . fingerprint($msg) . "' checking in\n"); + + # send empty payload back + return ""; } sub fingerprint