shlist

commit 6d678b8a5a5d61ad6cbddcd06a71fa8e91ba4fbd
parent a3613ba9f362371578ddbe816704fdbd9585a612
Author: kyle <kyle@0x30.net>
Date:   Wed, 20 Jan 2016 21:22:59 -0700

sl: harden against bad json payloads

- wrap decode_json in a try/catch block (perl can do that too, never knew)
  - fail hard in catch as we tried to parse invalid json
- also add a check that we get back a dictionary root, as array roots are also
  supported in json (according to internet)
- add new test for this stuff too

Diffstat:
M
server/sl
 | 
15
+++++++++++++--
A
server/tests/bad_payloads/Makefile
 | 
1
+
A
server/tests/bad_payloads/server.log.good
 | 
6
++++++
A
server/tests/bad_payloads/test.pl
 | 
12
++++++++++++

4 files changed, 32 insertions(+), 2 deletions(-)
diff --git a/server/sl b/server/sl
@@ -10,6 +10,7 @@ use Getopt::Std;
 use IO::Socket::SSL;
 use JSON::XS;
 use Scalar::Util qw(looks_like_number);
+use Try::Tiny;
 
 require "msgs.pl";
 our (%msg_num, @msg_str, @msg_func, $protocol_ver);
@@ -117,9 +118,19 @@ sub recv_msg {
 	}
 
 	my $payload = read_all($sock, $payload_size);
-	my $request = decode_json($payload);
 
-	return ($version, $msg_type, $request);
+	try {
+		my $request = decode_json($payload);
+
+		if (ref($request) ne "HASH") {
+			$log->print("error: json payload didn't have dictionary root\n");
+			exit 0;
+		}
+		return ($version, $msg_type, $request);
+	} catch {
+		$log->print("error: payload wasn't json\n");
+		exit 0;
+	}
 }
 
 sub read_all {
diff --git a/server/tests/bad_payloads/Makefile b/server/tests/bad_payloads/Makefile
@@ -0,0 +1 @@
+include ../test.mk
diff --git a/server/tests/bad_payloads/server.log.good b/server/tests/bad_payloads/server.log.good
@@ -0,0 +1,6 @@
+new connection (pid = <digits>)
+ssl ok, ver = 'TLSv1_2' cipher = 'ECDHE-RSA-AES128-SHA256'
+error: payload wasn't json
+new connection (pid = <digits>)
+ssl ok, ver = 'TLSv1_2' cipher = 'ECDHE-RSA-AES128-SHA256'
+error: json payload didn't have dictionary root
diff --git a/server/tests/bad_payloads/test.pl b/server/tests/bad_payloads/test.pl
@@ -0,0 +1,12 @@
+#!/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);