1 | #!@PERL@ |
---|
2 | # |
---|
3 | # $Id$ |
---|
4 | # |
---|
5 | eval "exec @PERL@ -S $0 $*" |
---|
6 | if $running_under_some_shell; |
---|
7 | |
---|
8 | # dump shared memory segment tony@divnc.com |
---|
9 | |
---|
10 | require 'sys/shm.ph'; |
---|
11 | require 'getopts.pl'; |
---|
12 | &Getopts("vhi:k:f:l:b:w"); # verbose, help, id, key, first, length, word, base |
---|
13 | |
---|
14 | if ($opt_h || ($opt_i && $opt_k)) |
---|
15 | { |
---|
16 | print STDERR <<NO_MORE_HELP; |
---|
17 | shmdump |
---|
18 | |
---|
19 | Dump contents of specifed shared memory segment. |
---|
20 | |
---|
21 | Usage: $0 [options] |
---|
22 | |
---|
23 | -h -- help |
---|
24 | -v -- possibly more verbose |
---|
25 | -i shmid -- shm id |
---|
26 | -k shmkey -- shm key |
---|
27 | -f first -- start of partial dump |
---|
28 | -l length -- length of partial dump |
---|
29 | -w -- dump as 4byte words instead of bytes |
---|
30 | -b base -- use 'base' as base address for output |
---|
31 | |
---|
32 | anything else == this help message |
---|
33 | NO_MORE_HELP |
---|
34 | exit 1; |
---|
35 | } |
---|
36 | |
---|
37 | $verbose = $opt_v; |
---|
38 | $id = $opt_i; |
---|
39 | $key = $opt_k; |
---|
40 | $offset = $opt_f; |
---|
41 | $print_length = $opt_l; |
---|
42 | $base = $opt_b; |
---|
43 | $word_dump = $opt_w; |
---|
44 | |
---|
45 | if ($key) |
---|
46 | { |
---|
47 | # ensure key is an integer |
---|
48 | $key = oct($key) if $key =~ /^0/; |
---|
49 | die "Could not convert key to id; $!" unless $id = shmget($key, 1, 0); |
---|
50 | } |
---|
51 | |
---|
52 | # ensure integerhood in case of leading '0x' |
---|
53 | $base = oct($base) if $base =~ /^0/; |
---|
54 | $offset = oct($offset) if $offset =~ /^0/; |
---|
55 | $print_length = oct($print_length) if $print_length =~ /^0/; |
---|
56 | |
---|
57 | if ( ! shmctl($id, &IPC_STAT, $shmid_ds)) |
---|
58 | { |
---|
59 | die "shmctl(2) for id $id failed -- (I was trying to get size): $!"; |
---|
60 | } |
---|
61 | |
---|
62 | # Pick the length out. |
---|
63 | # It is at byte offset 0x30 on hpux9 and probably hpux10 |
---|
64 | # Also get the key if we don't have it already. Don't need it tho... |
---|
65 | $length = unpack("I", substr($shmid_ds, 0x30, 4)); |
---|
66 | $key = unpack("I", substr($shmid_ds, 0x14, 4)) if ! $key; |
---|
67 | |
---|
68 | # poke around looking for length and key |
---|
69 | # print "I guess: length: $length, key: $key\n"; |
---|
70 | # print "****$shmid_ds****\n"; die ""; |
---|
71 | |
---|
72 | # make sure offset and print length make sense |
---|
73 | $print_length = $length if ! $print_length; |
---|
74 | if (($offset + $print_length) > $length) |
---|
75 | { |
---|
76 | die "offset ($offset) and length ($print_length) go beyond end of segment ($length bytes)"; |
---|
77 | } |
---|
78 | |
---|
79 | printf("KEY: 0x%X (%d) ", $key, $key) if ($key); |
---|
80 | printf "ID: $id\n"; |
---|
81 | printf " %d bytes (0x%X), %d words, logical base is 0x%X\n", |
---|
82 | $length, $length, $length / 4, $base; |
---|
83 | if ($offset || ($print_length != $length)) |
---|
84 | { |
---|
85 | printf " printing %X (%d) bytes starting at offset 0x%X (%d)\n", |
---|
86 | $print_length, $print_length, $offset, $offset; |
---|
87 | } |
---|
88 | printf "\n"; |
---|
89 | |
---|
90 | if ( ! shmread($id, $shm_data, $offset, $print_length)) |
---|
91 | { |
---|
92 | die "could not attach and read from shmid $id: $!"; |
---|
93 | } |
---|
94 | |
---|
95 | # the dump code below derived from "Real Perl Programs" example "xdump" |
---|
96 | # from Camel book |
---|
97 | |
---|
98 | $base += $offset; |
---|
99 | $offset = 0; |
---|
100 | for ($len = $print_length; $len >= 16; ) |
---|
101 | { |
---|
102 | $data = substr($shm_data, $offset, 16); |
---|
103 | |
---|
104 | @array = unpack('N4', $data); |
---|
105 | $data =~ tr/\0-\37\177-\377/./; |
---|
106 | printf "%8.8lX %8.8lX %8.8lX %8.8lX %8.8lX |%s|\n", |
---|
107 | $base, @array, $data; |
---|
108 | |
---|
109 | $offset += 16; |
---|
110 | $base += 16; |
---|
111 | $len -= 16; |
---|
112 | } |
---|
113 | |
---|
114 | # Now finish up the end a byte at a time |
---|
115 | |
---|
116 | if ($len) |
---|
117 | { |
---|
118 | $data = substr($shm_data, $offset, $len); |
---|
119 | @array = unpack('C*', $data); |
---|
120 | for (@array) |
---|
121 | { |
---|
122 | $_ = sprintf('%2.2X', $_); |
---|
123 | } |
---|
124 | |
---|
125 | push(@array, ' ') while $len++ < 16; |
---|
126 | |
---|
127 | $data =~ tr/\0-\37\177-\377/./; |
---|
128 | $data =~ s/[^ -~]/./g; |
---|
129 | |
---|
130 | printf "%8.8lX ", $base; |
---|
131 | printf "%s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s |%-16s|\n", |
---|
132 | @array, $data; |
---|
133 | } |
---|
134 | |
---|