beb62006 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use FileHandle; |
6 | |
7 | my $dumpchannels = 0; |
8 | my $dumpdata = 0; |
9 | while ($ARGV[0] =~ /^-/) { |
10 | my $opt = shift @ARGV; |
11 | if ($opt eq "--") { |
12 | last; # stop processing options |
13 | } elsif ($opt eq "-c") { |
14 | $dumpchannels = 1; |
15 | } elsif ($opt eq "-d") { |
16 | $dumpdata = 1; |
17 | } else { |
18 | die "unrecognised option '$opt'\n"; |
19 | } |
20 | } |
21 | |
22 | my @channels = (); # ultimate channel ids are indices in this array |
23 | my %chan_by_id = (); # indexed by 'c%d' or 's%d' for client and server ids |
24 | my %globalreq = (); # indexed by 'i' or 'o' |
25 | |
26 | my %packets = ( |
27 | #define SSH2_MSG_DISCONNECT 1 /* 0x1 */ |
28 | 'SSH2_MSG_DISCONNECT' => sub { |
29 | my ($direction, $seq, $data) = @_; |
30 | my ($reason, $description, $lang) = &parse("uss", $data); |
31 | printf "%s\n", &str($description); |
32 | }, |
33 | #define SSH2_MSG_IGNORE 2 /* 0x2 */ |
34 | 'SSH2_MSG_IGNORE' => sub { |
35 | my ($direction, $seq, $data) = @_; |
36 | my ($str) = &parse("s", $data); |
37 | printf "(%d bytes)\n", length $str; |
38 | }, |
39 | #define SSH2_MSG_UNIMPLEMENTED 3 /* 0x3 */ |
40 | 'SSH2_MSG_UNIMPLEMENTED' => sub { |
41 | my ($direction, $seq, $data) = @_; |
42 | my ($rseq) = &parse("u", $data); |
43 | printf "i%d\n", $rseq; |
44 | }, |
45 | #define SSH2_MSG_DEBUG 4 /* 0x4 */ |
46 | 'SSH2_MSG_DEBUG' => sub { |
47 | my ($direction, $seq, $data) = @_; |
48 | my ($disp, $message, $lang) = &parse("bss", $data); |
49 | printf "%s\n", &str($message); |
50 | }, |
51 | #define SSH2_MSG_SERVICE_REQUEST 5 /* 0x5 */ |
52 | 'SSH2_MSG_SERVICE_REQUEST' => sub { |
53 | my ($direction, $seq, $data) = @_; |
54 | my ($service) = &parse("s", $data); |
55 | printf "%s\n", &str($service); |
56 | }, |
57 | #define SSH2_MSG_SERVICE_ACCEPT 6 /* 0x6 */ |
58 | 'SSH2_MSG_SERVICE_ACCEPT' => sub { |
59 | my ($direction, $seq, $data) = @_; |
60 | my ($service) = &parse("s", $data); |
61 | printf "%s\n", &str($service); |
62 | }, |
63 | #define SSH2_MSG_KEXINIT 20 /* 0x14 */ |
64 | 'SSH2_MSG_KEXINIT' => sub { |
65 | my ($direction, $seq, $data) = @_; |
66 | print "\n"; |
67 | }, |
68 | #define SSH2_MSG_NEWKEYS 21 /* 0x15 */ |
69 | 'SSH2_MSG_NEWKEYS' => sub { |
70 | my ($direction, $seq, $data) = @_; |
71 | print "\n"; |
72 | }, |
73 | #define SSH2_MSG_KEXDH_INIT 30 /* 0x1e */ |
74 | 'SSH2_MSG_KEXDH_INIT' => sub { |
75 | my ($direction, $seq, $data) = @_; |
76 | print "\n"; |
77 | }, |
78 | #define SSH2_MSG_KEXDH_REPLY 31 /* 0x1f */ |
79 | 'SSH2_MSG_KEXDH_REPLY' => sub { |
80 | my ($direction, $seq, $data) = @_; |
81 | print "\n"; |
82 | }, |
83 | #define SSH2_MSG_KEX_DH_GEX_REQUEST 30 /* 0x1e */ |
84 | 'SSH2_MSG_KEX_DH_GEX_REQUEST' => sub { |
85 | my ($direction, $seq, $data) = @_; |
86 | print "\n"; |
87 | }, |
88 | #define SSH2_MSG_KEX_DH_GEX_GROUP 31 /* 0x1f */ |
89 | 'SSH2_MSG_KEX_DH_GEX_GROUP' => sub { |
90 | my ($direction, $seq, $data) = @_; |
91 | print "\n"; |
92 | }, |
93 | #define SSH2_MSG_KEX_DH_GEX_INIT 32 /* 0x20 */ |
94 | 'SSH2_MSG_KEX_DH_GEX_INIT' => sub { |
95 | my ($direction, $seq, $data) = @_; |
96 | print "\n"; |
97 | }, |
98 | #define SSH2_MSG_KEX_DH_GEX_REPLY 33 /* 0x21 */ |
99 | 'SSH2_MSG_KEX_DH_GEX_REPLY' => sub { |
100 | my ($direction, $seq, $data) = @_; |
101 | print "\n"; |
102 | }, |
103 | #define SSH2_MSG_KEXRSA_PUBKEY 30 /* 0x1e */ |
104 | 'SSH2_MSG_KEXRSA_PUBKEY' => sub { |
105 | my ($direction, $seq, $data) = @_; |
106 | print "\n"; |
107 | }, |
108 | #define SSH2_MSG_KEXRSA_SECRET 31 /* 0x1f */ |
109 | 'SSH2_MSG_KEXRSA_SECRET' => sub { |
110 | my ($direction, $seq, $data) = @_; |
111 | print "\n"; |
112 | }, |
113 | #define SSH2_MSG_KEXRSA_DONE 32 /* 0x20 */ |
114 | 'SSH2_MSG_KEXRSA_DONE' => sub { |
115 | my ($direction, $seq, $data) = @_; |
116 | print "\n"; |
117 | }, |
118 | #define SSH2_MSG_USERAUTH_REQUEST 50 /* 0x32 */ |
119 | 'SSH2_MSG_USERAUTH_REQUEST' => sub { |
120 | my ($direction, $seq, $data) = @_; |
121 | my ($user, $service, $method) = &parse("sss", $data); |
122 | my $out = sprintf "%s %s %s", |
123 | &str($user), &str($service), &str($method); |
124 | if ($method eq "publickey") { |
125 | my ($real) = &parse("b", $data); |
126 | $out .= " real=$real"; |
127 | } elsif ($method eq "password") { |
128 | my ($change) = &parse("b", $data); |
129 | $out .= " change=$change"; |
130 | } |
131 | print "$out\n"; |
132 | }, |
133 | #define SSH2_MSG_USERAUTH_FAILURE 51 /* 0x33 */ |
134 | 'SSH2_MSG_USERAUTH_FAILURE' => sub { |
135 | my ($direction, $seq, $data) = @_; |
136 | my ($options) = &parse("s", $data); |
137 | printf "%s\n", &str($options); |
138 | }, |
139 | #define SSH2_MSG_USERAUTH_SUCCESS 52 /* 0x34 */ |
140 | 'SSH2_MSG_USERAUTH_SUCCESS' => sub { |
141 | my ($direction, $seq, $data) = @_; |
142 | print "\n"; |
143 | }, |
144 | #define SSH2_MSG_USERAUTH_BANNER 53 /* 0x35 */ |
145 | 'SSH2_MSG_USERAUTH_BANNER' => sub { |
146 | my ($direction, $seq, $data) = @_; |
147 | print "\n"; |
148 | }, |
149 | #define SSH2_MSG_USERAUTH_PK_OK 60 /* 0x3c */ |
150 | 'SSH2_MSG_USERAUTH_PK_OK' => sub { |
151 | my ($direction, $seq, $data) = @_; |
152 | print "\n"; |
153 | }, |
154 | #define SSH2_MSG_USERAUTH_PASSWD_CHANGEREQ 60 /* 0x3c */ |
155 | 'SSH2_MSG_USERAUTH_PASSWD_CHANGEREQ' => sub { |
156 | my ($direction, $seq, $data) = @_; |
157 | print "\n"; |
158 | }, |
159 | #define SSH2_MSG_USERAUTH_INFO_REQUEST 60 /* 0x3c */ |
160 | 'SSH2_MSG_USERAUTH_INFO_REQUEST' => sub { |
161 | my ($direction, $seq, $data) = @_; |
162 | print "\n"; |
163 | }, |
164 | #define SSH2_MSG_USERAUTH_INFO_RESPONSE 61 /* 0x3d */ |
165 | 'SSH2_MSG_USERAUTH_INFO_RESPONSE' => sub { |
166 | my ($direction, $seq, $data) = @_; |
167 | print "\n"; |
168 | }, |
169 | #define SSH2_MSG_GLOBAL_REQUEST 80 /* 0x50 */ |
170 | 'SSH2_MSG_GLOBAL_REQUEST' => sub { |
171 | my ($direction, $seq, $data) = @_; |
172 | my ($type, $wantreply) = &parse("sb", $data); |
173 | printf "%s (%s)", $type, $wantreply eq "yes" ? "reply" : "noreply"; |
174 | my $request = [$seq, $type]; |
c7730e2d |
175 | push @{$globalreq{$direction}}, $request if $wantreply eq "yes"; |
beb62006 |
176 | if ($type eq "tcpip-forward" or $type eq "cancel-tcpip-forward") { |
177 | my ($addr, $port) = &parse("su", $data); |
178 | printf " %s:%s", $addr, $port; |
179 | push @$request, $port; |
180 | } |
181 | print "\n"; |
182 | }, |
183 | #define SSH2_MSG_REQUEST_SUCCESS 81 /* 0x51 */ |
184 | 'SSH2_MSG_REQUEST_SUCCESS' => sub { |
185 | my ($direction, $seq, $data) = @_; |
186 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
187 | my $request = shift @{$globalreq{$otherdir}}; |
188 | if (defined $request) { |
189 | printf "to %s", $request->[0]; |
190 | if ($request->[1] eq "tcpip-forward" and $request->[2] == 0) { |
191 | my ($port) = &parse("u", $data); |
192 | printf " port=%s", $port; |
193 | } |
194 | } else { |
195 | print "(spurious?)"; |
196 | } |
197 | print "\n"; |
198 | }, |
199 | #define SSH2_MSG_REQUEST_FAILURE 82 /* 0x52 */ |
200 | 'SSH2_MSG_REQUEST_FAILURE' => sub { |
201 | my ($direction, $seq, $data) = @_; |
202 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
203 | my $request = shift @{$globalreq{$otherdir}}; |
204 | if (defined $request) { |
205 | printf "to %s", $request->[0]; |
206 | } else { |
207 | print "(spurious?)"; |
208 | } |
209 | print "\n"; |
210 | }, |
211 | #define SSH2_MSG_CHANNEL_OPEN 90 /* 0x5a */ |
212 | 'SSH2_MSG_CHANNEL_OPEN' => sub { |
213 | my ($direction, $seq, $data) = @_; |
214 | my ($type, $sid, $winsize, $packet) = &parse("suuu", $data); |
215 | # CHANNEL_OPEN tells the other side the _sender's_ id for the |
216 | # channel, so this choice between "s" and "c" prefixes is |
217 | # opposite to every other message in the protocol, which all |
218 | # quote the _recipient's_ id of the channel. |
219 | $sid = ($direction eq "i" ? "s" : "c") . $sid; |
4f2f7f03 |
220 | my $chan = {'id'=>$sid, 'state'=>'halfopen', |
221 | 'i'=>{'win'=>0, 'seq'=>0}, |
222 | 'o'=>{'win'=>0, 'seq'=>0}}; |
223 | $chan->{$direction}{'win'} = $winsize; |
beb62006 |
224 | push @channels, $chan; |
225 | my $index = $#channels; |
226 | $chan_by_id{$sid} = $index; |
4f2f7f03 |
227 | printf "ch%d (%s) %s (--%d)", $index, $chan->{'id'}, $type, |
228 | $chan->{$direction}{'win'}; |
beb62006 |
229 | if ($type eq "x11") { |
230 | my ($addr, $port) = &parse("su", $data); |
231 | printf " from %s:%s", $addr, $port; |
232 | } elsif ($type eq "forwarded-tcpip") { |
233 | my ($saddr, $sport, $paddr, $pport) = &parse("susu", $data); |
234 | printf " to %s:%s from %s:%s", $saddr, $sport, $paddr, $pport; |
235 | } elsif ($type eq "direct-tcpip") { |
236 | my ($daddr, $dport, $saddr, $sport) = &parse("susu", $data); |
237 | printf " to %s:%s from %s:%s", $daddr, $dport, $saddr, $sport; |
238 | } |
239 | print "\n"; |
240 | }, |
241 | #define SSH2_MSG_CHANNEL_OPEN_CONFIRMATION 91 /* 0x5b */ |
242 | 'SSH2_MSG_CHANNEL_OPEN_CONFIRMATION' => sub { |
243 | my ($direction, $seq, $data) = @_; |
244 | my ($rid, $sid, $winsize, $packet) = &parse("uuuu", $data); |
245 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
246 | my $index = $chan_by_id{$rid}; |
247 | $sid = ($direction eq "i" ? "s" : "c") . $sid; |
248 | $chan_by_id{$sid} = $index; |
249 | my $chan = $channels[$index]; |
250 | $chan->{'id'} = ($direction eq "i" ? "$rid/$sid" : "$sid/$rid"); |
251 | $chan->{'state'} = 'open'; |
4f2f7f03 |
252 | $chan->{$direction}{'win'} = $winsize; |
253 | printf "ch%d (%s) (--%d)\n", $index, $chan->{'id'}, |
254 | $chan->{$direction}{'win'}; |
beb62006 |
255 | }, |
256 | #define SSH2_MSG_CHANNEL_OPEN_FAILURE 92 /* 0x5c */ |
257 | 'SSH2_MSG_CHANNEL_OPEN_FAILURE' => sub { |
258 | my ($direction, $seq, $data) = @_; |
259 | my ($rid, $reason, $desc, $lang) = &parse("uuss", $data); |
260 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
261 | my $index = $chan_by_id{$rid}; |
262 | my $chan = $channels[$index]; |
263 | $chan->{'state'} = 'rejected'; |
264 | printf "ch%d (%s) %s\n", $index, $chan->{'id'}, &str($reason); |
265 | }, |
266 | #define SSH2_MSG_CHANNEL_WINDOW_ADJUST 93 /* 0x5d */ |
267 | 'SSH2_MSG_CHANNEL_WINDOW_ADJUST' => sub { |
268 | my ($direction, $seq, $data) = @_; |
269 | my ($rid, $bytes) = &parse("uu", $data); |
270 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
271 | my $index = $chan_by_id{$rid}; |
272 | my $chan = $channels[$index]; |
4f2f7f03 |
273 | $chan->{$direction}{'win'} += $bytes; |
274 | printf "ch%d (%s) +%d (--%d)\n", $index, $chan->{'id'}, $bytes, |
275 | $chan->{$direction}{'win'}; |
beb62006 |
276 | }, |
277 | #define SSH2_MSG_CHANNEL_DATA 94 /* 0x5e */ |
278 | 'SSH2_MSG_CHANNEL_DATA' => sub { |
279 | my ($direction, $seq, $data) = @_; |
280 | my ($rid, $bytes) = &parse("uu", $data); |
281 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
282 | my $index = $chan_by_id{$rid}; |
283 | my $chan = $channels[$index]; |
4f2f7f03 |
284 | $chan->{$direction}{'seq'} += $bytes; |
285 | printf "ch%d (%s), %s bytes (%d--%d)\n", $index, $chan->{'id'}, $bytes, |
286 | $chan->{$direction}{'seq'}-$bytes, $chan->{$direction}{'seq'}; |
1f7a2b70 |
287 | my @realdata = splice @$data, 0, $bytes; |
beb62006 |
288 | if ($dumpdata) { |
289 | my $filekey = $direction . "file"; |
290 | if (!defined $chan->{$filekey}) { |
291 | my $filename = sprintf "ch%d.%s", $index, $direction; |
292 | $chan->{$filekey} = FileHandle->new(">$filename"); |
293 | if (!defined $chan->{$filekey}) { |
294 | die "$filename: $!\n"; |
295 | } |
296 | } |
beb62006 |
297 | die "channel data not present in $seq\n" if @realdata < $bytes; |
298 | my $rawdata = pack "C*", @realdata; |
299 | my $fh = $chan->{$filekey}; |
300 | print $fh $rawdata; |
301 | } |
1f7a2b70 |
302 | if (@realdata == $bytes and defined $chan->{$direction."data"}) { |
303 | my $rawdata = pack "C*", @realdata; |
304 | $chan->{$direction."data"}->($chan, $index, $direction, $rawdata); |
305 | } |
beb62006 |
306 | }, |
307 | #define SSH2_MSG_CHANNEL_EXTENDED_DATA 95 /* 0x5f */ |
308 | 'SSH2_MSG_CHANNEL_EXTENDED_DATA' => sub { |
309 | my ($direction, $seq, $data) = @_; |
310 | my ($rid, $bytes) = &parse("uu", $data); |
311 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
312 | my $index = $chan_by_id{$rid}; |
313 | my $chan = $channels[$index]; |
4f2f7f03 |
314 | my $dir = $direction eq "i" ? 'sc' : 'cs'; |
315 | $chan->{$dir}{'seq'} += $bytes; |
316 | printf "ch%d (%s), %s bytes (%d--%d)\n", $index, $chan->{'id'}, $bytes, |
317 | $chan->{$dir}{$seq}-$bytes, $chan->{$dir}{$seq}; |
beb62006 |
318 | printf "ch%d (%s), %s bytes\n", $index, $chan->{'id'}, $bytes; |
1f7a2b70 |
319 | my @realdata = splice @$data, 0, $bytes; |
beb62006 |
320 | if ($dumpdata) { |
321 | # We treat EXTENDED_DATA as equivalent to DATA, for the |
322 | # moment. It's not clear what else would be a better thing |
323 | # to do with it, and this at least is the Right Answer if |
324 | # the data is going to a terminal and the aim is to debug |
325 | # the terminal emulator. |
326 | my $filekey = $direction . "file"; |
327 | if (!defined $chan->{$filekey}) { |
328 | my $filename = sprintf "ch%d.%s", $index, $direction; |
329 | $chan->{$filekey} = FileHandle->new; |
330 | if (!$chan->{$filekey}->open(">", $filename)) { |
331 | die "$filename: $!\n"; |
332 | } |
333 | } |
beb62006 |
334 | die "channel data not present in $seq\n" if @realdata < $bytes; |
335 | my $rawdata = pack "C*", @realdata; |
336 | my $fh = $chan->{$filekey}; |
337 | print $fh $rawdata; |
338 | } |
1f7a2b70 |
339 | if (@realdata == $bytes and defined $chan->{$direction."data"}) { |
340 | my $rawdata = pack "C*", @realdata; |
341 | $chan->{$direction."data"}->($chan, $index, $direction, $rawdata); |
342 | } |
beb62006 |
343 | }, |
344 | #define SSH2_MSG_CHANNEL_EOF 96 /* 0x60 */ |
345 | 'SSH2_MSG_CHANNEL_EOF' => sub { |
346 | my ($direction, $seq, $data) = @_; |
347 | my ($rid) = &parse("uu", $data); |
348 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
349 | my $index = $chan_by_id{$rid}; |
350 | my $chan = $channels[$index]; |
351 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
352 | }, |
353 | #define SSH2_MSG_CHANNEL_CLOSE 97 /* 0x61 */ |
354 | 'SSH2_MSG_CHANNEL_CLOSE' => sub { |
355 | my ($direction, $seq, $data) = @_; |
356 | my ($rid) = &parse("uu", $data); |
357 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
358 | my $index = $chan_by_id{$rid}; |
359 | my $chan = $channels[$index]; |
360 | $chan->{'state'} = ($chan->{'state'} eq "open" ? "halfclosed" : |
361 | $chan->{'state'} eq "halfclosed" ? "closed" : |
362 | "confused"); |
363 | if ($chan->{'state'} eq "closed") { |
364 | $chan->{'ifile'}->close if defined $chan->{'ifile'}; |
365 | $chan->{'ofile'}->close if defined $chan->{'ofile'}; |
366 | } |
367 | printf "ch%d (%s)\n", $index, $chan->{'id'}; |
368 | }, |
369 | #define SSH2_MSG_CHANNEL_REQUEST 98 /* 0x62 */ |
370 | 'SSH2_MSG_CHANNEL_REQUEST' => sub { |
371 | my ($direction, $seq, $data) = @_; |
372 | my ($rid, $type, $wantreply) = &parse("usb", $data); |
373 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
374 | my $index = $chan_by_id{$rid}; |
375 | my $chan = $channels[$index]; |
376 | printf "ch%d (%s) %s (%s)", |
377 | $index, $chan->{'id'}, $type, $wantreply eq "yes" ? "reply" : "noreply"; |
c7730e2d |
378 | push @{$chan->{'requests_'.$direction}}, [$seq, $type] |
379 | if $wantreply eq "yes"; |
beb62006 |
380 | if ($type eq "pty-req") { |
381 | my ($term, $w, $h, $pw, $ph, $modes) = &parse("suuuus", $data); |
382 | printf " %s %sx%s", &str($term), $w, $h; |
383 | } elsif ($type eq "x11-req") { |
384 | my ($single, $xprot, $xcookie, $xscreen) = &parse("bssu", $data); |
385 | print " one-off" if $single eq "yes"; |
386 | printf " %s :%s", $xprot, $xscreen; |
387 | } elsif ($type eq "exec") { |
388 | my ($command) = &parse("s", $data); |
389 | printf " %s", &str($command); |
390 | } elsif ($type eq "subsystem") { |
391 | my ($subsys) = &parse("s", $data); |
392 | printf " %s", &str($subsys); |
1f7a2b70 |
393 | if ($subsys eq "sftp") { |
394 | &sftp_setup($index); |
395 | } |
beb62006 |
396 | } elsif ($type eq "window-change") { |
397 | my ($w, $h, $pw, $ph) = &parse("uuuu", $data); |
398 | printf " %sx%s", $w, $h; |
399 | } elsif ($type eq "xon-xoff") { |
400 | my ($can) = &parse("b", $data); |
401 | printf " %s", $can; |
402 | } elsif ($type eq "signal") { |
403 | my ($sig) = &parse("s", $data); |
404 | printf " %s", &str($sig); |
405 | } elsif ($type eq "exit-status") { |
406 | my ($status) = &parse("u", $data); |
407 | printf " %s", $status; |
408 | } elsif ($type eq "exit-signal") { |
409 | my ($sig, $core, $error, $lang) = &parse("sbss", $data); |
410 | printf " %s", &str($sig); |
411 | print " (core dumped)" if $core eq "yes"; |
412 | } |
413 | print "\n"; |
414 | }, |
415 | #define SSH2_MSG_CHANNEL_SUCCESS 99 /* 0x63 */ |
416 | 'SSH2_MSG_CHANNEL_SUCCESS' => sub { |
417 | my ($direction, $seq, $data) = @_; |
418 | my ($rid) = &parse("uu", $data); |
419 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
420 | my $index = $chan_by_id{$rid}; |
421 | my $chan = $channels[$index]; |
422 | printf "ch%d (%s)", $index, $chan->{'id'}; |
423 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
424 | my $request = shift @{$chan->{'requests_' . $otherdir}}; |
425 | if (defined $request) { |
426 | printf " to %s", $request->[0]; |
427 | } else { |
428 | print " (spurious?)"; |
429 | } |
430 | print "\n"; |
431 | }, |
432 | #define SSH2_MSG_CHANNEL_FAILURE 100 /* 0x64 */ |
433 | 'SSH2_MSG_CHANNEL_FAILURE' => sub { |
434 | my ($direction, $seq, $data) = @_; |
435 | my ($rid) = &parse("uu", $data); |
436 | $rid = ($direction eq "i" ? "c" : "s") . $rid; |
437 | my $index = $chan_by_id{$rid}; |
438 | my $chan = $channels[$index]; |
439 | printf "ch%d (%s)", $index, $chan->{'id'}; |
440 | my $otherdir = ($direction eq "i" ? "o" : "i"); |
441 | my $request = shift @{$chan->{'requests_' . $otherdir}}; |
442 | if (defined $request) { |
142228d2 |
443 | printf " to %s", $request->[0]; |
beb62006 |
444 | } else { |
445 | print " (spurious?)"; |
446 | } |
447 | print "\n"; |
448 | }, |
449 | #define SSH2_MSG_USERAUTH_GSSAPI_RESPONSE 60 |
450 | 'SSH2_MSG_USERAUTH_GSSAPI_RESPONSE' => sub { |
451 | my ($direction, $seq, $data) = @_; |
452 | print "\n"; |
453 | }, |
454 | #define SSH2_MSG_USERAUTH_GSSAPI_TOKEN 61 |
455 | 'SSH2_MSG_USERAUTH_GSSAPI_TOKEN' => sub { |
456 | my ($direction, $seq, $data) = @_; |
457 | print "\n"; |
458 | }, |
459 | #define SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE 63 |
460 | 'SSH2_MSG_USERAUTH_GSSAPI_EXCHANGE_COMPLETE' => sub { |
461 | my ($direction, $seq, $data) = @_; |
462 | print "\n"; |
463 | }, |
464 | #define SSH2_MSG_USERAUTH_GSSAPI_ERROR 64 |
465 | 'SSH2_MSG_USERAUTH_GSSAPI_ERROR' => sub { |
466 | my ($direction, $seq, $data) = @_; |
467 | print "\n"; |
468 | }, |
469 | #define SSH2_MSG_USERAUTH_GSSAPI_ERRTOK 65 |
470 | 'SSH2_MSG_USERAUTH_GSSAPI_ERRTOK' => sub { |
471 | my ($direction, $seq, $data) = @_; |
472 | print "\n"; |
473 | }, |
474 | #define SSH2_MSG_USERAUTH_GSSAPI_MIC 66 |
475 | 'SSH2_MSG_USERAUTH_GSSAPI_MIC' => sub { |
476 | my ($direction, $seq, $data) = @_; |
477 | print "\n"; |
478 | }, |
479 | ); |
480 | |
1f7a2b70 |
481 | my %sftp_packets = ( |
482 | #define SSH_FXP_INIT 1 /* 0x1 */ |
483 | 0x1 => sub { |
484 | my ($chan, $index, $direction, $id, $data) = @_; |
485 | my ($ver) = &parse("u", $data); |
486 | printf "SSH_FXP_INIT %d\n", $ver; |
487 | }, |
488 | #define SSH_FXP_VERSION 2 /* 0x2 */ |
489 | 0x2 => sub { |
490 | my ($chan, $index, $direction, $id, $data) = @_; |
491 | my ($ver) = &parse("u", $data); |
492 | printf "SSH_FXP_VERSION %d\n", $ver; |
493 | }, |
494 | #define SSH_FXP_OPEN 3 /* 0x3 */ |
495 | 0x3 => sub { |
496 | my ($chan, $index, $direction, $id, $data) = @_; |
497 | my ($reqid, $path, $pflags) = &parse("usu", $data); |
498 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_OPEN"); |
499 | printf " \"%s\" ", $path; |
500 | if ($pflags eq 0) { |
501 | print "0"; |
502 | } else { |
503 | my $sep = ""; |
504 | if ($pflags & 1) { $pflags ^= 1; print "${sep}READ"; $sep = "|"; } |
505 | if ($pflags & 2) { $pflags ^= 2; print "${sep}WRITE"; $sep = "|"; } |
506 | if ($pflags & 4) { $pflags ^= 4; print "${sep}APPEND"; $sep = "|"; } |
507 | if ($pflags & 8) { $pflags ^= 8; print "${sep}CREAT"; $sep = "|"; } |
508 | if ($pflags & 16) { $pflags ^= 16; print "${sep}TRUNC"; $sep = "|"; } |
509 | if ($pflags & 32) { $pflags ^= 32; print "${sep}EXCL"; $sep = "|"; } |
510 | if ($pflags) { print "${sep}${pflags}"; } |
511 | } |
512 | print "\n"; |
513 | }, |
514 | #define SSH_FXP_CLOSE 4 /* 0x4 */ |
515 | 0x4 => sub { |
516 | my ($chan, $index, $direction, $id, $data) = @_; |
517 | my ($reqid, $handle) = &parse("us", $data); |
518 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_CLOSE"); |
519 | printf " \"%s\"", &stringescape($handle); |
520 | print "\n"; |
521 | }, |
522 | #define SSH_FXP_READ 5 /* 0x5 */ |
523 | 0x5 => sub { |
524 | my ($chan, $index, $direction, $id, $data) = @_; |
525 | my ($reqid, $handle, $offset, $len) = &parse("usUu", $data); |
526 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_READ"); |
527 | printf " \"%s\" %d %d", &stringescape($handle), $offset, $len; |
528 | print "\n"; |
529 | }, |
530 | #define SSH_FXP_WRITE 6 /* 0x6 */ |
531 | 0x6 => sub { |
532 | my ($chan, $index, $direction, $id, $data) = @_; |
533 | my ($reqid, $handle, $offset, $wdata) = &parse("usUs", $data); |
534 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_WRITE"); |
535 | printf " \"%s\" %d [%d bytes]", &stringescape($handle), $offset, length $wdata; |
536 | print "\n"; |
537 | }, |
538 | #define SSH_FXP_LSTAT 7 /* 0x7 */ |
539 | 0x7 => sub { |
540 | my ($chan, $index, $direction, $id, $data) = @_; |
541 | my ($reqid, $path) = &parse("us", $data); |
542 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_LSTAT"); |
543 | printf " \"%s\"", $path; |
544 | print "\n"; |
545 | }, |
546 | #define SSH_FXP_FSTAT 8 /* 0x8 */ |
547 | 0x8 => sub { |
548 | my ($chan, $index, $direction, $id, $data) = @_; |
549 | my ($reqid, $handle) = &parse("us", $data); |
550 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_FSTAT"); |
551 | printf " \"%s\"", &stringescape($handle); |
552 | print "\n"; |
553 | }, |
554 | #define SSH_FXP_SETSTAT 9 /* 0x9 */ |
555 | 0x9 => sub { |
556 | my ($chan, $index, $direction, $id, $data) = @_; |
557 | my ($reqid, $path) = &parse("us", $data); |
558 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_SETSTAT"); |
559 | my $attrs = &sftp_parse_attrs($data); |
560 | printf " \"%s\" %s", $path, $attrs; |
561 | print "\n"; |
562 | }, |
563 | #define SSH_FXP_FSETSTAT 10 /* 0xa */ |
564 | 0xa => sub { |
565 | my ($chan, $index, $direction, $id, $data) = @_; |
566 | my ($reqid, $handle) = &parse("us", $data); |
567 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_FSETSTAT"); |
568 | my $attrs = &sftp_parse_attrs($data); |
569 | printf " \"%s\" %s", &stringescape($handle), $attrs; |
570 | print "\n"; |
571 | }, |
572 | #define SSH_FXP_OPENDIR 11 /* 0xb */ |
573 | 0xb => sub { |
574 | my ($chan, $index, $direction, $id, $data) = @_; |
575 | my ($reqid, $path) = &parse("us", $data); |
576 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_OPENDIR"); |
577 | printf " \"%s\"", $path; |
578 | print "\n"; |
579 | }, |
580 | #define SSH_FXP_READDIR 12 /* 0xc */ |
581 | 0xc => sub { |
582 | my ($chan, $index, $direction, $id, $data) = @_; |
583 | my ($reqid, $handle) = &parse("us", $data); |
584 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_READDIR"); |
585 | printf " \"%s\"", &stringescape($handle); |
586 | print "\n"; |
587 | }, |
588 | #define SSH_FXP_REMOVE 13 /* 0xd */ |
589 | 0xd => sub { |
590 | my ($chan, $index, $direction, $id, $data) = @_; |
591 | my ($reqid, $path) = &parse("us", $data); |
592 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_REMOVE"); |
593 | printf " \"%s\"", $path; |
594 | print "\n"; |
595 | }, |
596 | #define SSH_FXP_MKDIR 14 /* 0xe */ |
597 | 0xe => sub { |
598 | my ($chan, $index, $direction, $id, $data) = @_; |
599 | my ($reqid, $path) = &parse("us", $data); |
600 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_MKDIR"); |
601 | printf " \"%s\"", $path; |
602 | print "\n"; |
603 | }, |
604 | #define SSH_FXP_RMDIR 15 /* 0xf */ |
605 | 0xf => sub { |
606 | my ($chan, $index, $direction, $id, $data) = @_; |
607 | my ($reqid, $path) = &parse("us", $data); |
608 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_RMDIR"); |
609 | printf " \"%s\"", $path; |
610 | print "\n"; |
611 | }, |
612 | #define SSH_FXP_REALPATH 16 /* 0x10 */ |
613 | 0x10 => sub { |
614 | my ($chan, $index, $direction, $id, $data) = @_; |
615 | my ($reqid, $path) = &parse("us", $data); |
616 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_REALPATH"); |
617 | printf " \"%s\"", $path; |
618 | print "\n"; |
619 | }, |
620 | #define SSH_FXP_STAT 17 /* 0x11 */ |
621 | 0x11 => sub { |
622 | my ($chan, $index, $direction, $id, $data) = @_; |
623 | my ($reqid, $path) = &parse("us", $data); |
624 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_STAT"); |
625 | printf " \"%s\"", $path; |
626 | print "\n"; |
627 | }, |
628 | #define SSH_FXP_RENAME 18 /* 0x12 */ |
629 | 0x12 => sub { |
630 | my ($chan, $index, $direction, $id, $data) = @_; |
631 | my ($reqid, $srcpath, $dstpath) = &parse("uss", $data); |
632 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_RENAME"); |
633 | printf " \"%s\" \"%s\"", $srcpath, $dstpath; |
634 | print "\n"; |
635 | }, |
636 | #define SSH_FXP_STATUS 101 /* 0x65 */ |
637 | 0x65 => sub { |
638 | my ($chan, $index, $direction, $id, $data) = @_; |
639 | my ($reqid, $status) = &parse("uu", $data); |
640 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_STATUS"); |
641 | print " "; |
642 | if ($status eq "0") { print "SSH_FX_OK"; } |
643 | elsif ($status eq "1") { print "SSH_FX_EOF"; } |
644 | elsif ($status eq "2") { print "SSH_FX_NO_SUCH_FILE"; } |
645 | elsif ($status eq "3") { print "SSH_FX_PERMISSION_DENIED"; } |
646 | elsif ($status eq "4") { print "SSH_FX_FAILURE"; } |
647 | elsif ($status eq "5") { print "SSH_FX_BAD_MESSAGE"; } |
648 | elsif ($status eq "6") { print "SSH_FX_NO_CONNECTION"; } |
649 | elsif ($status eq "7") { print "SSH_FX_CONNECTION_LOST"; } |
650 | elsif ($status eq "8") { print "SSH_FX_OP_UNSUPPORTED"; } |
651 | else { printf "[unknown status %d]", $status; } |
652 | print "\n"; |
653 | }, |
654 | #define SSH_FXP_HANDLE 102 /* 0x66 */ |
655 | 0x66 => sub { |
656 | my ($chan, $index, $direction, $id, $data) = @_; |
657 | my ($reqid, $handle) = &parse("us", $data); |
658 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_HANDLE"); |
659 | printf " \"%s\"", &stringescape($handle); |
660 | print "\n"; |
661 | }, |
662 | #define SSH_FXP_DATA 103 /* 0x67 */ |
663 | 0x67 => sub { |
664 | my ($chan, $index, $direction, $id, $data) = @_; |
665 | my ($reqid, $retdata) = &parse("us", $data); |
666 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_DATA"); |
667 | printf " [%d bytes]", length $retdata; |
668 | print "\n"; |
669 | }, |
670 | #define SSH_FXP_NAME 104 /* 0x68 */ |
671 | 0x68 => sub { |
672 | my ($chan, $index, $direction, $id, $data) = @_; |
673 | my ($reqid, $count) = &parse("uu", $data); |
674 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_NAME"); |
675 | for my $i (1..$count) { |
676 | my ($name, $longname) = &parse("ss", $data); |
677 | my $attrs = &sftp_parse_attrs($data); |
678 | print " [name=\"$name\", longname=\"$longname\", attrs=$attrs]"; |
679 | } |
680 | print "\n"; |
681 | }, |
682 | #define SSH_FXP_ATTRS 105 /* 0x69 */ |
683 | 0x69 => sub { |
684 | my ($chan, $index, $direction, $id, $data) = @_; |
685 | my ($reqid) = &parse("u", $data); |
686 | &sftp_logreply($chan, $direction, $reqid, $id, "SSH_FXP_ATTRS"); |
687 | my $attrs = &sftp_parse_attrs($data); |
688 | printf " %s", $attrs; |
689 | print "\n"; |
690 | }, |
691 | #define SSH_FXP_EXTENDED 200 /* 0xc8 */ |
692 | 0xc8 => sub { |
693 | my ($chan, $index, $direction, $id, $data) = @_; |
694 | my ($reqid, $type) = &parse("us", $data); |
695 | &sftp_logreq($chan, $direction, $reqid, $id, "SSH_FXP_EXTENDED"); |
696 | printf " \"%s\"", $type; |
697 | print "\n"; |
698 | }, |
699 | #define SSH_FXP_EXTENDED_REPLY 201 /* 0xc9 */ |
700 | 0xc9 => sub { |
701 | my ($chan, $index, $direction, $id, $data) = @_; |
702 | my ($reqid) = &parse("u", $data); |
703 | print "\n"; |
704 | &sftp_logreply($chan, $direction, $reqid,$id,"SSH_FXP_EXTENDED_REPLY"); |
705 | }, |
706 | ); |
707 | |
beb62006 |
708 | my ($direction, $seq, $ourseq, $type, $data, $recording); |
709 | my %ourseqs = ('i'=>0, 'o'=>0); |
710 | |
711 | $recording = 0; |
712 | while (<>) { |
713 | if ($recording) { |
714 | if (/^ [0-9a-fA-F]{8} ((?:[0-9a-fA-F]{2} )*[0-9a-fA-F]{2})/) { |
715 | push @$data, map { $_ eq "XX" ? -1 : hex $_ } split / /, $1; |
716 | } else { |
717 | $recording = 0; |
718 | my $fullseq = "$direction$ourseq"; |
719 | print "$fullseq: $type "; |
720 | if (defined $packets{$type}) { |
721 | $packets{$type}->($direction, $fullseq, $data); |
722 | } else { |
723 | printf "raw %s\n", join "", map { sprintf "%02x", $_ } @$data; |
724 | } |
725 | } |
726 | } |
727 | if (/^(Incoming|Outgoing) packet #0x([0-9a-fA-F]+), type \d+ \/ 0x[0-9a-fA-F]+ \((.*)\)/) { |
728 | $direction = ($1 eq "Incoming" ? 'i' : 'o'); |
729 | # $seq is the sequence number quoted in the log file. $ourseq |
730 | # is our own count of the sequence number, which differs in |
731 | # that it shouldn't wrap at 2^32, should anyone manage to run |
732 | # this script over such a huge log file. |
733 | $seq = hex $2; |
734 | $ourseq = $ourseqs{$direction}++; |
735 | $type = $3; |
736 | $data = []; |
737 | $recording = 1; |
738 | } |
739 | } |
740 | |
741 | if ($dumpchannels) { |
742 | my %stateorder = ('closed'=>0, 'rejected'=>1, |
743 | 'halfclosed'=>2, 'open'=>3, 'halfopen'=>4); |
744 | for my $index (0..$#channels) { |
745 | my $chan = $channels[$index]; |
8a202ff9 |
746 | my $so = $stateorder{$chan->{'state'}}; |
747 | $so = 1000 unless defined $so; # any state I've missed above comes last |
beb62006 |
748 | $chan->{'index'} = sprintf "ch%d", $index; |
749 | $chan->{'order'} = sprintf "%08d %08d", $so, $index; |
750 | } |
751 | my @sortedchannels = sort { $a->{'order'} cmp $b->{'order'} } @channels; |
752 | for my $chan (@sortedchannels) { |
753 | printf "%s (%s): %s\n", $chan->{'index'}, $chan->{'id'}, $chan->{'state'}; |
754 | } |
755 | } |
756 | |
757 | sub parseone { |
758 | my ($type, $data) = @_; |
759 | if ($type eq "u") { # uint32 |
760 | my @bytes = splice @$data, 0, 4; |
761 | return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes; |
762 | return unpack "N", pack "C*", @bytes; |
763 | } elsif ($type eq "U") { # uint64 |
1f7a2b70 |
764 | my @bytes = splice @$data, 0, 8; |
beb62006 |
765 | return "<missing>" if @bytes < 8 or grep { $_<0 } @bytes; |
766 | my @words = unpack "NN", pack "C*", @bytes; |
767 | return ($words[0] << 32) + $words[1]; |
768 | } elsif ($type eq "b") { # boolean |
769 | my $byte = shift @$data; |
770 | return "<missing>" if !defined $byte or $byte < 0; |
771 | return $byte ? "yes" : "no"; |
772 | } elsif ($type eq "B") { # byte |
773 | my $byte = shift @$data; |
774 | return "<missing>" if !defined $byte or $byte < 0; |
775 | return $byte; |
776 | } elsif ($type eq "s" or $type eq "m") { # string, mpint |
777 | my @bytes = splice @$data, 0, 4; |
778 | return "<missing>" if @bytes < 4 or grep { $_<0 } @bytes; |
779 | my $len = unpack "N", pack "C*", @bytes; |
780 | @bytes = splice @$data, 0, $len; |
781 | return "<missing>" if @bytes < $len or grep { $_<0 } @bytes; |
782 | if ($type eq "mpint") { |
783 | my $str = ""; |
784 | if ($bytes[0] >= 128) { |
785 | # Take two's complement. |
786 | @bytes = map { 0xFF ^ $_ } @bytes; |
787 | for my $i (reverse 0..$#bytes) { |
788 | if ($bytes[$i] < 0xFF) { |
789 | $bytes[$i]++; |
790 | last; |
791 | } else { |
792 | $bytes[$i] = 0; |
793 | } |
794 | } |
795 | $str = "-"; |
796 | } |
797 | $str .= "0x" . join "", map { sprintf "%02x", $_ } @bytes; |
798 | return $str; |
799 | } else { |
800 | return pack "C*", @bytes; |
801 | } |
802 | } |
803 | } |
804 | |
805 | sub parse { |
806 | my ($template, $data) = @_; |
807 | return map { &parseone($_, $data) } split //, $template; |
808 | } |
809 | |
810 | sub str { |
811 | # Quote as a string. If I get enthusiastic I might arrange for |
812 | # strange characters inside the string to be quoted. |
813 | my $str = shift @_; |
814 | return "'$str'"; |
815 | } |
1f7a2b70 |
816 | |
817 | sub sftp_setup { |
818 | my $index = shift @_; |
819 | my $chan = $channels[$index]; |
820 | $chan->{'obuf'} = $chan->{'ibuf'} = ''; |
821 | $chan->{'ocnt'} = $chan->{'icnt'} = 0; |
822 | $chan->{'odata'} = $chan->{'idata'} = \&sftp_data; |
823 | $chan->{'sftpreqs'} = {}; |
824 | } |
825 | |
826 | sub sftp_data { |
827 | my ($chan, $index, $direction, $data) = @_; |
828 | my $buf = \$chan->{$direction."buf"}; |
829 | my $cnt = \$chan->{$direction."cnt"}; |
830 | $$buf .= $data; |
831 | while (length $$buf >= 4) { |
832 | my $msglen = unpack "N", $$buf; |
833 | last if length $$buf < 4 + $msglen; |
834 | my $msg = substr $$buf, 4, $msglen; |
835 | $$buf = substr $$buf, 4 + $msglen; |
836 | $msg = [unpack "C*", $msg]; |
837 | my $type = shift @$msg; |
838 | my $id = sprintf "ch%d_sftp_%s%d", $index, $direction, ${$cnt}++; |
839 | print "$id: "; |
840 | if (defined $sftp_packets{$type}) { |
841 | $sftp_packets{$type}->($chan, $index, $direction, $id, $msg); |
842 | } else { |
843 | printf "unknown SFTP packet type %d\n", $type; |
844 | } |
845 | } |
846 | } |
847 | |
848 | sub sftp_logreq { |
849 | my ($chan, $direction, $reqid, $id, $name) = @_; |
850 | print "$name"; |
851 | if ($direction eq "o") { # requests coming _in_ are too weird to track |
852 | $chan->{'sftpreqs'}->{$reqid} = $id; |
853 | } |
854 | } |
855 | |
856 | sub sftp_logreply { |
857 | my ($chan, $direction, $reqid, $id, $name) = @_; |
858 | print "$name"; |
859 | if ($direction eq "i") { # replies going _out_ are too weird to track |
860 | if (defined $chan->{'sftpreqs'}->{$reqid}) { |
861 | print " to ", $chan->{'sftpreqs'}->{$reqid}; |
862 | $chan->{'sftpreqs'}->{$reqid} = undef; |
863 | } |
864 | } |
865 | } |
866 | |
867 | sub sftp_parse_attrs { |
868 | my ($data) = @_; |
869 | my ($flags) = &parse("u", $data); |
870 | return $flags if $flags eq "<missing>"; |
871 | my $out = "{"; |
872 | my $sep = ""; |
873 | if ($flags & 0x00000001) { # SSH_FILEXFER_ATTR_SIZE |
874 | $out .= $sep . sprintf "size=%d", &parse("U", $data); |
875 | $sep = ", "; |
876 | } |
877 | if ($flags & 0x00000002) { # SSH_FILEXFER_ATTR_UIDGID |
878 | $out .= $sep . sprintf "uid=%d", &parse("u", $data); |
879 | $out .= $sep . sprintf "gid=%d", &parse("u", $data); |
880 | $sep = ", "; |
881 | } |
882 | if ($flags & 0x00000004) { # SSH_FILEXFER_ATTR_PERMISSIONS |
883 | $out .= $sep . sprintf "perms=%#o", &parse("u", $data); |
884 | $sep = ", "; |
885 | } |
886 | if ($flags & 0x00000008) { # SSH_FILEXFER_ATTR_ACMODTIME |
887 | $out .= $sep . sprintf "atime=%d", &parse("u", $data); |
888 | $out .= $sep . sprintf "mtime=%d", &parse("u", $data); |
889 | $sep = ", "; |
890 | } |
891 | if ($flags & 0x80000000) { # SSH_FILEXFER_ATTR_EXTENDED |
892 | my $extcount = &parse("u", $data); |
893 | while ($extcount-- > 0) { |
894 | $out .= $sep . sprintf "\"%s\"=\"%s\"", &parse("ss", $data); |
895 | $sep = ", "; |
896 | } |
897 | } |
898 | $out .= "}"; |
899 | return $out; |
900 | } |
901 | |
902 | sub stringescape { |
903 | my ($str) = @_; |
904 | $str =~ s!\\!\\\\!g; |
905 | $str =~ s![^ -~]!sprintf "\\x%02X", ord $&!eg; |
906 | return $str; |
907 | } |