Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | \ ========== Copyright Header Begin ========================================== |
2 | \ | |
3 | \ Hypervisor Software File: tcp-debug.fth | |
4 | \ | |
5 | \ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved. | |
6 | \ | |
7 | \ - Do no alter or remove copyright notices | |
8 | \ | |
9 | \ - Redistribution and use of this software in source and binary forms, with | |
10 | \ or without modification, are permitted provided that the following | |
11 | \ conditions are met: | |
12 | \ | |
13 | \ - Redistribution of source code must retain the above copyright notice, | |
14 | \ this list of conditions and the following disclaimer. | |
15 | \ | |
16 | \ - Redistribution in binary form must reproduce the above copyright notice, | |
17 | \ this list of conditions and the following disclaimer in the | |
18 | \ documentation and/or other materials provided with the distribution. | |
19 | \ | |
20 | \ Neither the name of Sun Microsystems, Inc. or the names of contributors | |
21 | \ may be used to endorse or promote products derived from this software | |
22 | \ without specific prior written permission. | |
23 | \ | |
24 | \ This software is provided "AS IS," without a warranty of any kind. | |
25 | \ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, | |
26 | \ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A | |
27 | \ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN | |
28 | \ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR | |
29 | \ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR | |
30 | \ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN | |
31 | \ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR | |
32 | \ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE | |
33 | \ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, | |
34 | \ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF | |
35 | \ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. | |
36 | \ | |
37 | \ You acknowledge that this software is not designed, licensed or | |
38 | \ intended for use in the design, construction, operation or maintenance of | |
39 | \ any nuclear facility. | |
40 | \ | |
41 | \ ========== Copyright Header End ============================================ | |
42 | id: @(#)tcp-debug.fth 1.1 04/09/07 | |
43 | purpose: TCP debug support | |
44 | copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved | |
45 | copyright: Use is subject to license terms. | |
46 | ||
47 | \ Post-mortem debugging support routines. | |
48 | ||
49 | [ifdef] DEBUG | |
50 | ||
51 | headerless | |
52 | ||
53 | create tcp-state-names | |
54 | " CLOSED" pstring, | |
55 | " LISTEN" pstring, | |
56 | " SYN_SENT" pstring, | |
57 | " SYN_RCVD" pstring, | |
58 | " ESTABLISHED" pstring, | |
59 | " CLOSE_WAIT" pstring, | |
60 | " FIN_WAIT_1" pstring, | |
61 | " CLOSING" pstring, | |
62 | " LAST_ACK" pstring, | |
63 | " FIN_WAIT_2" pstring, | |
64 | " TIME_WAIT" pstring, | |
65 | ||
66 | create soreq-names | |
67 | " ATTACH" pstring, | |
68 | " DETACH" pstring, | |
69 | " BIND" pstring, | |
70 | " CONNECT" pstring, | |
71 | " LISTEN" pstring, | |
72 | " ACCEPT" pstring, | |
73 | " SEND" pstring, | |
74 | " SENDTO" pstring, | |
75 | " RECV" pstring, | |
76 | " RECVFROM" pstring, | |
77 | ||
78 | : find-string ( table index -- $ ) 0 ?do count ca+ loop count ; | |
79 | ||
80 | : tcp-state-name ( record -- $ ) | |
81 | tcp-state-names swap >td-tcb tcb-state@ find-string | |
82 | ; | |
83 | ||
84 | : tcp-event-name ( record -- $ ) | |
85 | dup >td-event l@ case | |
86 | TR_INPUT of drop " Input" endof | |
87 | TR_SOCKET of | |
88 | soreq-names swap >td-req l@ find-string | |
89 | endof | |
90 | TR_OUTPUT of | |
91 | >td-tcb tcp-retransmitting? if " Rexmit" else " Output" then | |
92 | endof | |
93 | endcase | |
94 | ; | |
95 | ||
96 | : ftype ( adr len field-width -- ) | |
97 | over - >r type r> dup 0> if spaces else drop then | |
98 | ; | |
99 | ||
100 | \ Display information from TCP/IP header as | |
101 | \ [FLAGS] SEG.SEQ:SEG.END(SEG.LEN) SEG.ACK SEG.WND | |
102 | : show-packet-info ( pkt -- ) | |
103 | dup ip-len@ 0= if drop exit then ( pkt ) | |
104 | dup tcp-flags@ ( pkt flags ) | |
105 | ." [" ( pkt flags ) | |
106 | dup TH_ACK invert and if ( pkt flags ) | |
107 | dup TH_SYN and if ." S" then ( pkt flags ) | |
108 | dup TH_FIN and if ." F" then ( pkt flags ) | |
109 | dup TH_PSH and if ." P" then ( pkt flags ) | |
110 | TH_RST and if ." R" then ( pkt ) | |
111 | else ( pkt flags ) | |
112 | drop ." ." ( pkt ) | |
113 | then ( pkt ) | |
114 | ." ] " ( pkt ) | |
115 | base @ >r decimal ( pkt ) ( r: base ) | |
116 | dup seg-seq@ over seg-len@ ( pkt seg.seq seg.len ) | |
117 | over (u.) type ." :" ( pkt seg.seq seg.len ) | |
118 | tuck + (u.) type ." (" ( pkt seg.len ) | |
119 | (u.) type ." )" space ( pkt ) | |
120 | dup is-tcpack? if ( pkt ) | |
121 | ." ack " dup seg-ack@ u. ( pkt ) | |
122 | then ( pkt ) | |
123 | ." win " seg-wnd@ u. ( ) | |
124 | r> base ! ( ) ( r: ) | |
125 | ; | |
126 | ||
127 | \ Show a one line summary of the TCP event formatted as | |
128 | \ <tcp-state> <soreq-name> (for TR_SOCKET events) | |
129 | \ <tcp-state> <event> <pkt-info> (for TR_INPUT/TR_OUTPUT events) | |
130 | : show-tcptrace-event ( record -- ) | |
131 | dup tcp-state-name d# 12 ftype | |
132 | dup tcp-event-name d# 7 ftype | |
133 | dup >td-event l@ TR_SOCKET <> if | |
134 | dup >td-pkthdr show-packet-info | |
135 | then drop cr | |
136 | ; | |
137 | ||
138 | \ Dump out information from TCB. | |
139 | : show-tcb-vars ( tcb -- ) | |
140 | dup tcb>inpcb 0= if exit then | |
141 | base @ >r decimal | |
142 | 2 spaces | |
143 | ." rcv.nxt = " dup rcv-nxt@ . | |
144 | ." rcv.wnd = " dup rcv-wnd@ . cr | |
145 | 2 spaces | |
146 | ." snd.una = " dup snd-una@ . | |
147 | ." snd.nxt = " dup snd-nxt@ . | |
148 | ." snd.max = " dup snd-max@ . cr | |
149 | 2 spaces | |
150 | ." snd.wl1 = " dup snd-wl1@ . | |
151 | ." snd.wl2 = " dup snd-wl2@ . | |
152 | ." snd.wnd = " dup snd-wnd@ . cr | |
153 | 2 spaces | |
154 | ." snd.cwnd = " dup snd-cwnd@ . | |
155 | ." ssthresh = " dup ssthresh@ . cr | |
156 | 2 spaces | |
157 | ." rttseq = " dup >tcb-rttseq l@ . | |
158 | ." rtt = " dup >tcb-rtt l@ . | |
159 | ." srtt = " dup >tcb-srtt l@ 3 rshift . | |
160 | ." rttvar = " dup >tcb-rttvar l@ 2 rshift . | |
161 | ." rto = " >tcb-rto l@ . cr | |
162 | r> base ! | |
163 | ; | |
164 | ||
165 | : show-tcptrace-record ( record -- ) | |
166 | dup show-tcptrace-event >td-tcb show-tcb-vars cr | |
167 | ; | |
168 | ||
169 | headers | |
170 | ||
171 | \ Show all available information. | |
172 | : show-log ( -- ) | |
173 | ['] show-tcptrace-record show-tcptrace-data | |
174 | ; | |
175 | ||
176 | \ Show TCP event summary (1 line per event). | |
177 | : show-tcp-events ( -- ) | |
178 | ['] show-tcptrace-event show-tcptrace-data | |
179 | ; | |
180 | ||
181 | headerless | |
182 | ||
183 | [then] |