From 1c750e21b31f722fdfef1ac3e6f830d10a289185 Mon Sep 17 00:00:00 2001
From: Scott Francis <scott.francis@shopify.com>
Date: Sun, 7 Sep 2014 18:52:56 +0000
Subject: [PATCH] Add support for TCP tail loss probes

---
 man/man8/tcpretrans.8 |  9 ++++++-
 net/tcpretrans        | 56 +++++++++++++++++++++++++++++--------------
 2 files changed, 46 insertions(+), 19 deletions(-)

diff --git a/man/man8/tcpretrans.8 b/man/man8/tcpretrans.8
index f62687e..9a8efd8 100644
--- a/man/man8/tcpretrans.8
+++ b/man/man8/tcpretrans.8
@@ -3,7 +3,7 @@
 tcpretrans \- show TCP retransmits, with address and other details. Uses Linux ftrace.
 .SH SYNOPSIS
 .B tcpretrans
-[\-hs]
+[\-hsp]
 .SH DESCRIPTION
 This traces TCP retransmits that are sent by the system tcpretrans is executed
 from, showing address, port, and TCP state information,
@@ -25,6 +25,7 @@ Since this uses ftrace, only the root user can use this tool.
 .SH REQUIREMENTS
 FTRACE and KPROBE CONFIG, tcp_retransmit_skb() kernel function.
 You may have these already have these on recent kernels. And Perl.
+TCP tail loss probes were added in Linux 3.10.
 .SH OPTIONS
 .TP
 \-h
@@ -32,6 +33,9 @@ Print usage message.
 .TP
 \-s
 Include kernel stack traces.
+.TP
+\-p
+Include TCP tail loss probes.
 .SH EXAMPLES
 .TP
 Trace TCP retransmits
@@ -62,6 +66,9 @@ Remote port.
 .TP
 STATE
 TCP session state.
+.TP
+TLP
+Tail loss probe: "Y/N".
 .SH OVERHEAD
 The CPU overhead is relative to the rate of TCP retransmits, and is
 designed to be low as this does not examine every packet. Once per second the
diff --git a/net/tcpretrans b/net/tcpretrans
index ec46086..f0a64ae 100755
--- a/net/tcpretrans
+++ b/net/tcpretrans
@@ -8,7 +8,7 @@
 # sent by the kernel on timeouts). To keep overhead low, only
 # tcp_retransmit_skb() calls are traced (this does not trace every packet).
 #
-# USAGE: ./tcpretrans [-hs]
+# USAGE: ./tcpretrans [-hsp]
 #
 # REQUIREMENTS: FTRACE and KPROBE CONFIG, tcp_retransmit_skb() kernel function.
 # You may have these already have these on recent kernels. And Perl.
@@ -67,16 +67,18 @@ local $SIG{HUP} = \&cleanup;
 $| = 1;
 
 ### options
-my ($help, $stacks);
+my ($help, $stacks, $tlp);
 GetOptions("help|h"   => \$help,
-	   "stacks|s" => \$stacks)
+	   "stacks|s" => \$stacks,
+	   "tlp|p" => \$tlp)
 or usage();
 usage() if $help;
 
 sub usage {
-	print STDERR "USAGE: tcpretrans [-hs]\n";
+	print STDERR "USAGE: tcpretrans [-hsp]\n";
 	print STDERR "                  -h       # help message\n";
 	print STDERR "                  -s       # print stack traces\n";
+	print STDERR "                  -p       # trace TCP tail loss probes\n";
 	print STDERR "   eg,\n";
 	print STDERR "       tcpretrans          # trace TCP retransmits\n";
 	exit;
@@ -140,6 +142,27 @@ sub inet_h2a {
 	return join(".", @addr);
 }
 
+sub create_kprobe {
+	my ($kname, $kval) = @_;
+	appendto "p:$kname $kval", "kprobe_events"
+    or ldie "ERROR: creating kprobe for $kname.";
+}
+
+sub enable_kprobe {
+	my ($kname) = @_;
+	unless (writeto "1", "events/kprobes/$kname/enable") {
+		appendto "-:$kname", "kprobe_events";
+		ldie "ERROR: enabling kprobe.";
+	}
+}
+
+sub remove_kprobe {
+	my ($kname) = @_;
+	writeto "0", "events/kprobes/$kname/enable"
+	    or ldie "ERROR: disabling kprobe $kname";
+	appendto "-:$kname", "kprobe_events";
+}
+
 ### check permissions
 chdir "$tracing" or die "ERROR: accessing tracing. Root? Kernel has FTRACE?" .
     "\ndebugfs mounted? (mount -t debugfs debugfs /sys/kernel/debug)";
@@ -153,20 +176,18 @@ writeto "$$", $flock or die "ERROR: unable to write $flock.";
 
 ### setup and begin tracing
 writeto "nop", "current_tracer" or ldie "ERROR: disabling current_tracer.";
-my $kname = "tcpretrans_tcp_retransmit_skb";
-appendto "p:$kname tcp_retransmit_skb sk=%di", "kprobe_events"
-    or ldie "ERROR: creating kprobe for inet_csk_accept().";
+my ($kname, $kname_tlp) = ("tcpretrans_tcp_retransmit_skb", "tcpretrans_tcp_send_loss_probe");
+create_kprobe $kname, "tcp_retransmit_skb sk=%di";
+create_kprobe $kname_tlp, "tcp_send_loss_probe sk=%di" if $tlp;
 if ($stacks) {
 	writeto "1", "options/stacktrace" or print STDERR "WARNING: " .
 	    "unable to enable stacktraces.";
 }
-unless (writeto "1", "events/kprobes/$kname/enable") {
-	appendto "-:$kname", "kprobe_events";
-	ldie "ERROR: enabling kprobe.";
-}
+enable_kprobe $kname;
+enable_kprobe $kname_tlp if $tlp;
 map_tcp_states();
-printf "%-8s %-6s %-20s -- %-20s %s\n", "TIME", "PID",
-    "LADDR:LPORT", "RADDR:RPORT", "STATE";
+printf "%-8s %-6s %-20s -- %-20s %-12s %s\n", "TIME", "PID",
+    "LADDR:LPORT", "RADDR:RPORT", "STATE", "TLP";
 
 #
 # Read and print event data. This loop waits one second then reads the buffered
@@ -225,8 +246,8 @@ while (1) {
 		}
 
 		my $now = strftime "%H:%M:%S", localtime;
-		printf "%-8s %-6s %-20s R> %-20s %s\n", $now, $pid,
-		    "$laddr:$lport", "$raddr:$rport", $state;
+		printf "%-8s %-6s %-20s R> %-20s %-12s %s\n", $now, $pid,
+		    "$laddr:$lport", "$raddr:$rport", $state, $rest =~ /$kname_tlp/ ? "Y" : "N";
 	}
 }
 
@@ -240,9 +261,8 @@ sub cleanup {
 		writeto "0", "options/stacktrace" or print STDERR "WARNING: " .
 		    "unable to disable stacktraces.";
 	}
-	writeto "0", "events/kprobes/$kname/enable"
-	    or ldie "ERROR: disabling kprobe";
-	appendto "-:$kname", "kprobe_events";
+	remove_kprobe $kname;
+	remove_kprobe $kname_tlp if $tlp;
 	writeto "", "trace";
 	unlink $flock;
 	exit;