sl (24141B)
1 #!/usr/bin/perl -I. 2 use warnings; 3 use strict; 4 5 use BSD::arc4random qw(arc4random_bytes arc4random_stir); 6 use Digest::SHA qw(sha256_base64); 7 use File::Temp; 8 use Getopt::Std; 9 use IO::Socket::SSL; 10 use IO::Socket::UNIX; 11 use JSON::XS; 12 use Log::Log4perl qw(:easy :no_extra_logdie_message); 13 use Scalar::Util qw(looks_like_number); 14 15 use SL::Database; 16 17 require "msgs.pl"; 18 our (%msg_num, @msg_str, @msg_func, $protocol_ver); 19 20 my %args; 21 getopts("p:tv", \%args); 22 23 # This is used by the parent to create the database if it doesn't already 24 # exist. Each child then opens $db_file afterwards to do queries. 25 my $db_file = "db"; 26 $db_file = File::Temp->new(SUFFIX => '.db', EXLOCK => 0) if ($args{t}); 27 28 my $level = $ERROR; 29 $level = $DEBUG if ($args{v}); 30 31 Log::Log4perl->easy_init( { 32 level => $level, 33 utf8 => 1, 34 layout => '%d %P %p> %m%n' } ); 35 my $logger = get_logger('shlist.server'); 36 37 $logger->info("using database '$db_file'\n"); 38 39 my $db = SL::Database->new($db_file); 40 $db->create_tables(); 41 42 # Create TCP listening socket on port given by '-p' or 5437. 43 # All incoming connection requests will be accepted by this socket. 44 # SSL Shouldn't be enabled here, see 'man IO::Socket::SSL'. 45 my $server_socket = new IO::Socket::INET ( 46 LocalPort => $args{p} || '5437', 47 Proto => 'tcp', 48 Listen => 1, 49 ReuseAddr => 1, 50 ); 51 die "Could not create socket: $!\n" unless($server_socket); 52 53 my ($addr, $port) = ($server_socket->sockhost(), $server_socket->sockport()); 54 $logger->info("accepting connections on $addr:$port\n"); 55 56 # Children who have exited do not have to be waited on with this 57 $SIG{CHLD} = 'IGNORE'; 58 $SIG{TERM} = sub { exit 0 }; 59 60 # Accept new plain TCP connections and handle them in separate processes 61 while (my $client_socket = $server_socket->accept()) { 62 63 # Create a child process to handle this client 64 my $pid = fork(); 65 if (!defined $pid) { 66 die "error: can't fork: $!\n"; 67 } elsif ($pid) { 68 # In parent: close our copy of the client socket and listen again 69 close $client_socket; 70 next; 71 } 72 73 close $server_socket; 74 # Stir the random pool after fork() just in case 75 arc4random_stir(); 76 77 my $peer_addr = $client_socket->peerhost(); 78 $logger->debug("new connection from $peer_addr\n"); 79 80 # Upgrade plain TCP connection to SSL 81 my $ret = IO::Socket::SSL->start_SSL($client_socket, 82 SSL_server => 1, 83 SSL_cert_file => 'certs/cert_chain.pem', 84 SSL_key_file => 'certs/privkey.pem' 85 ); 86 $logger->logdie("error: $SSL_ERROR\n") unless ($ret); 87 88 my $ssl_ver = $client_socket->get_sslversion(); 89 my $ssl_cipher = $client_socket->get_cipher(); 90 $logger->debug("ssl ok, ver = '$ssl_ver' cipher = '$ssl_cipher'\n"); 91 92 my $db = SL::Database->new($db_file); 93 $db->prepare_stmt_handles(); 94 95 # Handle messages until this client disconnects 96 handle_message($client_socket, $db) while (1); 97 } 98 99 # Receives a request and sends a response. Also sometimes sends push 100 # notifications. Returns nothing. 101 sub handle_message { 102 my ($client_socket, $db) = @_; 103 104 # Make sure this gets reset 105 undef $@; 106 107 # Wait for an entire message to be received 108 my ($ver, $msg_type, $request) = recv_msg($client_socket); 109 110 $db->{dbh}->begin_work; 111 112 # Every message type except 'device_add' needs to include 'device_id' in 113 # the request. Check that here. 114 my $device = undef; 115 if ($msg_type != $msg_num{device_add}) { 116 (my $err, $device) = get_device($db, $request->{device_id}); 117 118 if ($err) { 119 send_msg($client_socket, $ver, $msg_type, make_error($err)); 120 $db->{dbh}->commit; 121 return; 122 } 123 } 124 125 # Call appropriate message handler. Each handler returns both data that 126 # should be sent back over the main socket and notification data that 127 # gets sent over vendor specific API. 128 my ($response, $notify) = $msg_func[$msg_type]->($db, $request->{data}, $device); 129 130 $db->{dbh}->commit; 131 if ($@) { 132 $logger->error("db transaction aborted: $@\n"); 133 134 # now rollback to undo the incomplete changes but do it in an 135 # eval{} as it may also fail 136 eval { $db->{dbh}->rollback }; 137 138 $response->{status} = 'err'; 139 $response->{reason} = 'database transaction aborted'; 140 141 send_msg($client_socket, $ver, $msg_type, $response); 142 return; 143 } 144 145 # Respond to client over the main socket 146 send_msg($client_socket, $ver, $msg_type, $response); 147 148 # Some messages don't send notifications 149 return if (! defined $notify); 150 151 # Don't send notifications when there was en error 152 return if ($response->{status} eq 'err'); 153 154 return if (@{ $notify->{devices} } == 0); 155 156 # Encode the notification message and find its size 157 my $msg = encode_json($notify); 158 my $msg_len = length($msg); 159 160 # Send to notification daemons 161 send_unix("../apnd.socket", $msg, $msg_len) unless ($args{t}); 162 send_unix("../gcmd.socket", $msg, $msg_len) unless ($args{t}); 163 send_unix("testd.socket", $msg, $msg_len) if ($args{t}); 164 } 165 166 # Takes a device id and verifies it is present and valid. 167 sub get_device { 168 my ($db, $device_id) = @_; 169 170 unless (defined $device_id) { 171 $logger->error("bad request, missing key 'device_id'\n"); 172 return ("a missing message argument was required"); 173 } 174 175 unless ($device_id && $device_id =~ m/^[a-zA-Z0-9+\/=]+$/) { 176 $logger->error("bad device id\n"); 177 return ('the client sent a device id that was not base64'); 178 } 179 180 $db->{select_device_id}->execute($device_id); 181 if (my ($num, $id, $phnum) = $db->{select_device_id}->fetchrow_array()) { 182 my $device = { 183 num => $num, 184 fp => fingerprint($id), 185 phnum => $phnum, 186 id => $id 187 }; 188 return (undef, $device); 189 } 190 191 $logger->error("unknown device '$device_id'\n"); 192 return ('the client sent an unknown device id'); 193 } 194 195 # Connect to a Unix domain socket and send a message. 196 # Returns nothing. 197 sub send_unix { 198 my ($socket_path, $msg, $msg_len) = @_; 199 200 my $socket = IO::Socket::UNIX->new( 201 Type => SOCK_STREAM(), 202 Peer => $socket_path 203 ); 204 unless ($socket) { 205 $logger->error("$socket_path: connect failed: $!\n"); 206 return; 207 } 208 209 # This is the same function we use for TCP data sending 210 send_all($socket, $msg, $msg_len); 211 212 close($socket); 213 } 214 215 # Receive a complete message from the network. Validates: 216 # - version, message type, payload size 217 # - payload is JSON and the root was an object 218 # Returns ($version, $msg_type, $payload) on success, exits on error. 219 sub recv_msg { 220 my ($sock) = @_; 221 222 # First read the fixed size 6 byte header 223 my $header = read_all($sock, 6); 224 my ($version, $msg_type, $payload_size) = unpack("nnn", $header); 225 226 # Check version and message type are in range 227 $logger->logdie("error: unsupported protocol version $version\n") if ($version != 0); 228 $logger->logdie("error: unknown message type $msg_type\n") if ($msg_type >= @msg_str); 229 230 # Server requests are limited to 4KB size, a 0 byte payload will not be 231 # valid JSON so reject that here too. 232 if ($payload_size > 4096 || $payload_size == 0) { 233 $logger->logdie("error: $payload_size byte payload invalid\n"); 234 } 235 236 # Now that we know the size of the message we can try and read the 237 # entire thing exactly 238 my $payload = read_all($sock, $payload_size); 239 240 # Throws an exception when $payload is bad JSON 241 my $request = decode_json($payload); 242 243 if (ref($request) ne "HASH") { 244 $logger->logdie("error: json payload didn't have dictionary root\n"); 245 } 246 return ($version, $msg_type, $request); 247 } 248 249 # Read an exact amount of bytes from a socket. 250 # Returns the data read from the socket on success, exits on error. 251 sub read_all { 252 my ($sock, $bytes_total) = @_; 253 254 my $data; 255 my $bytes_read = 0; 256 while ($bytes_total > 0) { 257 my $read = $sock->sysread($data, $bytes_total, $bytes_read); 258 259 $logger->logdie("error: read failed: $!\n") if (!defined $read); 260 $logger->logdie("disconnected!\n") if ($read == 0); 261 262 $bytes_total -= $read; 263 $bytes_read += $read; 264 } 265 266 return $data; 267 } 268 269 # Creates and sends a complete message by concatentating the following together: 270 # - version, message type, payload size 271 # - encoded JSON response (we can't send native UTF-8 strings here) 272 # Returns number of bytes sent on success, exits on failure. 273 sub send_msg { 274 my ($sock, $ver, $msg_type, $response) = @_; 275 276 # Transform $response into JSON string with no character values > 255. 277 my $payload = encode_json($response); 278 279 my $header_len = 6; 280 my $payload_len = length($payload); 281 282 if ($payload_len > 65535) { 283 # Don't send a response that's too large. 284 # But do send an error *saying* the response was too large. 285 $logger->error("error: $payload_len byte response too large to send"); 286 287 my $err = make_error("response too large"); 288 return send_msg($sock, $ver, $msg_type, $err); 289 } 290 291 send_all($sock, pack("nnn", $ver, $msg_type, $payload_len), $header_len); 292 send_all($sock, $payload, $payload_len); 293 294 return $header_len + $payload_len; 295 } 296 297 # Send an exact amount of bytes to a socket. SSL sends max 16KB per frame. 298 # Returns the number of bytes wrote, exits on write failure. 299 sub send_all { 300 my ($socket, $data, $bytes_total) = @_; 301 302 my $bytes_written = 0; 303 while ($bytes_total) { 304 my $wrote = $socket->syswrite($data, $bytes_total, $bytes_written); 305 306 $logger->logdie("error: write failed: $!\n") unless (defined $wrote); 307 308 $bytes_total -= $wrote; 309 $bytes_written += $wrote; 310 } 311 312 return $bytes_written; 313 } 314 315 # 'device_add' message handler. Validates incoming phone number, makes sure this 316 # phone number has not registered already and then creates a new device_id. 317 # Does not return any push notifications because this device has no friends yet. 318 sub msg_device_add { 319 my ($db, $request) = @_; 320 321 # XXX: check that these exists first 322 my $ph_num = $request->{'phone_number'}; 323 my $os = $request->{'os'}; 324 325 unless (looks_like_number($ph_num)) { 326 $logger->error("phone number invalid\n"); 327 return make_error("the sent phone number is not a number"); 328 } 329 330 $db->{ph_num_exists}->execute($ph_num); 331 if ($db->{ph_num_exists}->fetchrow_array()) { 332 $logger->error("phone number '$ph_num' already exists\n"); 333 return make_error("the sent phone number already exists"); 334 } 335 # Only accept a white list of operating systems 336 if ($os ne 'unix' && $os ne 'android' && $os ne 'ios') { 337 $logger->error("unknown operating system '$os'\n"); 338 return make_error("operating system not supported"); 339 } 340 341 # Create new 256 bit random hashed string that we use as the unique 342 # device id 343 my $device_id = sha256_base64(arc4random_bytes(32)); 344 my $fp = fingerprint($device_id); 345 346 # Check the database to make sure this isn't duplicate 347 $db->{select_device_id}->execute($device_id); 348 if ($db->{select_device_id}->fetchrow_array()) { 349 $logger->error("id generation collision for '$device_id'\n"); 350 return make_error("device id collision, please try again"); 351 } 352 353 $db->{new_device}->execute($device_id, $ph_num, $os, undef, time, time); 354 $logger->debug("success, '$ph_num':'$fp' os '$os'\n"); 355 356 return (make_ok( { data => $device_id } ), undef); 357 } 358 359 # 'device_update' message handler. Takes a device_id and a token and updates the 360 # devices table with the new token. Used so that the notification infrastructure 361 # knows about the latest token a device has. 362 # Returns with an ok message. 363 sub msg_device_update { 364 my ($db, $request, $dev) = @_; 365 366 $db->{update_device}->execute($request, $dev->{num}); 367 $logger->debug("push token = '$request'\n"); 368 369 return make_ok( { data => {} }); 370 } 371 372 # Takes a device_id and a list structure and records this list in the database. 373 # Also prepares an friend_added_list notification that should be sent to all my 374 # mutual friends. 375 sub msg_list_add { 376 my ($db, $list, $dev) = @_; 377 378 # XXX: check that $list contains the necessary keys! 379 380 $logger->debug("device '$dev->{fp}'\n"); 381 #$log->print("new list name '$list->{name}'\n"); 382 383 my $now = time; 384 # Create new list, use null for primary key so the new row automatically 385 # gets the lowest numbered integer that isn't used 386 $db->{new_list}->execute($list->{name}, $list->{date}, $now, $now); 387 my $list_num = $db->{dbh}->last_insert_id("", "", "", ""); 388 389 # Assign first reference count to the new list: the lists creator 390 $db->{new_list_member}->execute($list_num, $dev->{num}, $now); 391 392 # Send back a full list structure. Be extra careful about types here as 393 # this is serialized by encode_json and types in Perl can be... tricky. 394 my $resp_list = { 395 num => $list_num, 396 name => $list->{name}, 397 date => $list->{date}, 398 items_complete => 0, 399 items_total => 0, 400 members => [ $dev->{phnum} ], 401 num_members => 1 402 }; 403 my $response = make_ok( { data => $resp_list } ); 404 405 $logger->debug("new list number is '$list_num'\n"); 406 407 # For push notifications a list add on your part means all your friends 408 # gain a list in their other lists section. Create the same response 409 # that lists_get_other gives back for the notify payload 410 $db->{mutual_friend_notify_select}->execute($dev->{num}); 411 my $notify->{devices} = $db->{mutual_friend_notify_select}->fetchall_arrayref(); 412 413 # Prepare a smaller list structure that will be sent to every device 414 # selected above. Their client shows your new lists in their other lists 415 # section, which doesn't need a lot of information. 416 $notify->{msg_type} = 'friend_added_list'; 417 $notify->{data} = { 418 num => $resp_list->{num}, 419 name => $list->{name}, 420 members => [ $dev->{phnum} ], 421 num_members => 1 422 }; 423 424 return ($response, $notify); 425 } 426 427 sub msg_list_update { 428 my ($db, $list, $dev) = @_; 429 430 my ($err) = list_number_valid($db, $list->{num}); 431 return make_error($err) if ($err); 432 433 # Check that the device is in the list it wants to update 434 $db->{check_list_member}->execute($list->{num}, $dev->{num}); 435 unless ($db->{check_list_member}->fetchrow_array()) { 436 $logger->error("device '$dev->{fp}' not in list '$list->{num}'\n"); 437 return make_error("client tried to update a list it was not in"); 438 } 439 440 # Notify all of my mutual friends that my list changed 441 $db->{mutual_friend_notify_select}->execute($dev->{num}); 442 my $mutual_friends = $db->{mutual_friend_notify_select}->fetchall_arrayref(); 443 444 # Notify all of the other list members that this list changed 445 $db->{select_list_members}->execute($list->{num}, $dev->{num}); 446 my $list_members = $db->{select_list_members}->fetchall_arrayref(); 447 448 my $notify; 449 $notify->{devices} = [@{ $mutual_friends }, @{ $list_members }]; 450 451 $notify->{msg_type} = 'updated_list'; 452 $notify->{data} = { 453 num => $list->{num}, 454 name => $list->{name}, 455 date => $list->{date} 456 }; 457 # print Dumper($notify); 458 459 # Update list row, note that some values here can be optional 460 $db->{update_list}->execute($list->{name}, $list->{date}, time, $list->{num}); 461 $logger->debug("num = '$list->{num}'\n"); 462 $logger->debug("name = '$list->{name}'\n") if (exists $list->{name}); 463 $logger->debug("date = $list->{date}\n") if (exists $list->{date}); 464 465 return (make_ok( { data => {} } ), $notify); 466 } 467 468 sub msg_list_item_add { 469 my ($db, $request, $device) = @_; 470 471 return make_error("unimplemented"); 472 473 # my ($list_id, $position, $text) = split ("\0", $msg); 474 475 # print "info: $addr: list $list_id\n"; 476 # print "info: $addr: position\n"; 477 # print "info: $addr: text $text\n"; 478 479 # check that list exists 480 # check if item exists 481 # check for "" owner on a stack 482 # either create or add to unowned stack 483 # owner will be emtpy 484 # last_update 485 } 486 487 sub msg_list_join { 488 my ($db, $list_num, $dev) = @_; 489 490 my ($list_err, $list_num_num, $list_name, $list_date) = list_number_valid($db, $list_num); 491 return make_error($list_err) if ($list_err); 492 493 my $time = time; 494 $db->{check_list_member}->execute($list_num, $dev->{num}); 495 496 if (!$db->{check_list_member}->fetchrow_array()) { 497 $db->{new_list_member}->execute($list_num, $dev->{num}, $time); 498 $logger->debug("device '$dev->{fp}' has been added to list '$list_num'\n"); 499 } else { 500 $logger->error("tried to create a duplicate list member entry for device '$dev->{fp}' and list '$list_num'\n"); 501 return make_error("the device is already part of this list"); 502 } 503 504 $db->{list_members_phnums}->execute($list_num); 505 my $members_ref = $db->{list_members_phnums}->fetchall_arrayref(); 506 # $members_ref comes back as an array of arrays, flatten it 507 my @members = map {@$_} @$members_ref; 508 509 my $list = { 510 num => $list_num_num, 511 name => $list_name, 512 date => $list_date, 513 items_complete => 0, 514 items_total => 0, 515 members => \@members, 516 num_members => scalar(@members) 517 }; 518 519 $logger->debug("device '$dev->{fp}'\n"); 520 $logger->debug("list '$list_num'\n"); 521 522 return make_ok( { data => $list } ); 523 } 524 525 sub msg_list_leave { 526 my ($db, $list_num, $dev) = @_; 527 528 my ($err) = list_number_valid($db, $list_num); 529 return make_error($err) if ($err); 530 531 $db->{check_list_member}->execute($list_num, $dev->{num}); 532 533 my $tmp_list_num = $list_num; 534 if ($db->{check_list_member}->fetchrow_array()) { 535 $db->{remove_list_member}->execute($list_num, $dev->{num}); 536 $logger->debug("device '$dev->{fp}' has been removed from list '$tmp_list_num'\n"); 537 } else { 538 $logger->error("tried to leave a list the user was not in for device '$dev->{fp}' and list '$tmp_list_num'\n"); 539 return make_error("the client was not a member of the list"); 540 } 541 $db->{check_list_member}->finish(); 542 543 $db->{get_list_members}->execute($list_num); 544 545 my $list_empty = 0; 546 547 if (!$db->{get_list_members}->fetchrow_array()) { 548 $logger->debug("list '$tmp_list_num' is empty... deleting\n"); 549 $db->{delete_list}->execute($list_num); 550 $db->{delete_list_data}->execute($list_num); 551 $list_empty = 1; 552 } 553 554 my $response = { 555 list_num => $list_num, 556 list_empty => $list_empty 557 }; 558 559 $logger->debug("device '$dev->{fp}'\n"); 560 $logger->debug("list '$list_num'\n"); 561 562 return make_ok( { data => $response } ); 563 } 564 565 sub msg_friend_add { 566 my ($db, $friend_phnum, $dev) = @_; 567 568 $logger->debug("'$dev->{fp}' adding '$friend_phnum'\n"); 569 570 unless (looks_like_number($friend_phnum)) { 571 $logger->error("bad friends number '$friend_phnum'\n"); 572 return make_error("friends phone number is not a valid phone number"); 573 } 574 575 # Check if I'm adding myself as a friend 576 if ($dev->{phnum} eq $friend_phnum) { 577 $logger->error("device '$dev->{fp}' tried adding itself\n"); 578 return make_error("device cannot add itself as a friend"); 579 } 580 581 # Add a 1 way friendship for this person 582 $db->{friends_insert}->execute($dev->{num}, $friend_phnum); 583 584 # Check if the added friend has registered their phone number 585 $db->{ph_num_exists}->execute($friend_phnum); 586 if (my ($friend_num, $friend_devid) = $db->{ph_num_exists}->fetchrow_array()) { 587 588 $logger->debug("added friend is a member\n"); 589 my $friend_fp = fingerprint($friend_devid); 590 $logger->debug("friends device id is '$friend_fp'\n"); 591 592 # Check if my phone number is in their friends list 593 $db->{friends_select}->execute($friend_num, $dev->{phnum}); 594 if ($db->{friends_select}->fetchrow_array()) { 595 $logger->debug("found mutual friendship\n"); 596 597 # Adding both is not necessary but makes lookups easier 598 $db->{mutual_friend_insert}->execute($dev->{num}, $friend_num); 599 $db->{mutual_friend_insert}->execute($friend_num, $dev->{num}); 600 } 601 } 602 603 return make_ok( { data => $friend_phnum } ); 604 } 605 606 sub msg_friend_delete { 607 my ($db, $friend_phnum, $dev) = @_; 608 609 unless (looks_like_number($friend_phnum)) { 610 $logger->error("bad friends number '$friend_phnum'\n"); 611 return make_error("friends phone number is not a valid phone number"); 612 } 613 614 $db->{friends_select}->execute($dev->{num}, $friend_phnum); 615 if ($db->{friends_select}->fetchrow_array()) { 616 $logger->debug("removing '$friend_phnum' from friends list\n"); 617 $db->{friends_delete}->execute($dev->{num}, $friend_phnum); 618 } 619 else { 620 $logger->error("tried deleting friend '$friend_phnum' but they weren't a friend\n"); 621 return make_error("friend sent for deletion was not a friend"); 622 } 623 624 # Check for and delete any mutual friend references 625 $db->{ph_num_exists}->execute($friend_phnum); 626 if (my ($friend_num) = $db->{ph_num_exists}->fetchrow_array()) { 627 628 $logger->debug("also removing mutual friend relationship\n"); 629 $db->{mutual_friends_delete}->execute($dev->{num}, $friend_num); 630 $db->{mutual_friends_delete}->execute($friend_num, $dev->{num}); 631 } 632 633 return make_ok( { data => $friend_phnum } ); 634 } 635 636 # Takes no arguments and finds all of the lists that the given device_id is in. 637 # Fills out complete list structures to send back. 638 # This message doesn't send any notifications. 639 sub msg_lists_get { 640 my ($db, $request, $dev) = @_; 641 642 $logger->debug("gathering lists for '$dev->{fp}'\n"); 643 644 my @lists; 645 # Find all lists that this device number is a member of 646 $db->{get_lists}->execute($dev->{num}); 647 while (my ($num, $name, $date) = $db->{get_lists}->fetchrow_array()) { 648 649 # Get the phone numbers of all the list members 650 $db->{list_members_phnums}->execute($num); 651 my $members_ref = $db->{list_members_phnums}->fetchall_arrayref(); 652 653 # $members_ref comes back as an array of arrays, flatten it 654 my @members = map {@$_} @$members_ref; 655 656 my $num_members = scalar(@members); 657 my $list = { 658 num => $num, 659 name => $name, 660 date => $date, 661 items_complete => 0, 662 items_total => 0, 663 members => \@members, 664 num_members => $num_members 665 }; 666 push @lists, $list; 667 668 $logger->debug("found list '$num':'$name'\n"); 669 $logger->debug("list has $num_members members\n"); 670 $logger->debug("list has 0 items\n"); 671 } 672 673 return make_ok( { data => \@lists} ); 674 } 675 676 sub msg_lists_get_other { 677 my ($db, $request, $dev) = @_; 678 679 $logger->debug("gathering lists for '$dev->{fp}'\n"); 680 681 my %list_nums; 682 # Find all mutual friends of this device 683 $db->{mutual_friend_select}->execute($dev->{num}); 684 while (my @row = $db->{mutual_friend_select}->fetchrow_array()) { 685 686 my ($friend_num, $friend_phnum) = @row; 687 $logger->debug("found mutual friend '$friend_phnum'\n"); 688 689 # Find all of the lists my mutual friend is in (but not me) 690 $db->{get_other_lists}->execute($friend_num, $dev->{num}); 691 while (my ($list_num) = $db->{get_other_lists}->fetchrow_array()) { 692 693 my $lookup = $list_num; 694 if (exists $list_nums{$lookup}) { 695 # Append member and move on 696 push @{ $list_nums{$lookup}->{members} }, $friend_phnum; 697 $list_nums{$lookup}->{num_members} += 1; 698 next 699 } 700 701 $db->{list_select}->execute($list_num); 702 my (undef, $name) = $db->{list_select}->fetchrow_array(); 703 704 my $list = { 705 num => $list_num, 706 name => $name, 707 members => [ $friend_phnum ], 708 num_members => 1 709 }; 710 $list_nums{$list_num} = $list; 711 $logger->debug("found list '$name'\n"); 712 } 713 } 714 715 my @other_lists = values(%list_nums); 716 return make_ok( { data => \@other_lists } ); 717 } 718 719 sub msg_list_items_get { 720 my ($db, $request, $dev) = @_; 721 722 my $list_id = $request->{'list_num'}; 723 724 if (!$list_id) { 725 $logger->error("received null list id"); 726 return make_error("the sent list id was empty"); 727 } 728 # unless ($dbh->selectrow_array($sth{check_list_member}, undef, $list_id, $device_id)) { 729 # # XXX: table list_members list_id's should always exist in table lists 730 # $log->print("list_items: $device_id not a member of $list_id\n"); 731 # return "err\0the sent device id is not a member of the list"; 732 # } 733 $logger->debug("$dev->{id} request items for $list_id\n"); 734 735 $db->{get_list_items}->execute($list_id); 736 737 my @items; 738 while (my ($list_id, $pos, $name, $status, $owner, undef) = 739 $db->{get_list_items}->fetchrow_array()) { 740 $logger->error("list item #$pos $name\n"); 741 742 push @items, "$pos:$name:$owner:$status"; 743 } 744 745 my $out = join("\0", @items); 746 return make_ok(); 747 } 748 749 sub fingerprint { 750 return substr shift, 0, 8; 751 } 752 753 sub list_number_valid { 754 my ($db, $list_num) = @_; 755 756 unless (defined $list_num) { 757 $logger->error("list number key not found\n"); 758 return ("the client did not send a list number"); 759 } 760 761 unless (looks_like_number($list_num)) { 762 $logger->error("'$list_num' is not a number\n"); 763 return ("the client sent a list number that was not a number"); 764 } 765 766 $db->{list_select}->execute($list_num); 767 if (my @row = $db->{list_select}->fetchrow_array()) { 768 return (undef, @row); 769 } 770 771 $logger->error("unknown list number '$list_num'\n"); 772 return ("the client sent an unknown list number"); 773 } 774 775 sub make_error { 776 my ($reason) = @_; 777 return { status => 'err', reason => $reason }; 778 } 779 780 sub make_ok { 781 my ($args) = @_; 782 783 $args->{status} = 'ok'; 784 return $args; 785 }