forked from omgneeq/ps3utils
-
Notifications
You must be signed in to change notification settings - Fork 0
/
registry.tcl
executable file
·273 lines (237 loc) · 7.19 KB
/
registry.tcl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
#!/usr/bin/wish
#
# Copyright (C) Youness Alaoui (KaKaRoTo)
#
# This software is distributed under the terms of the GNU General Public
# License ("GPL") version 3, as published by the Free Software Foundation.
#
proc hexify { str } {
set out ""
for {set i 0} { $i < [string length $str] } { incr i} {
set c [string range $str $i $i]
if {[string is ascii $c] && (![string is control $c] || $c == "\r" || $c == "\n") } {
append out $c
} else {
binary scan $c H* h
append out "\[[string toupper $h]\]"
}
}
set out
}
proc hexify_all { str } {
set out ""
for {set i 0} { $i < [string length $str] } { incr i} {
set c [string range $str $i $i]
binary scan $c H* h
append out "\[[string toupper $h]\]"
}
set out
}
proc unhexify { str } {
set out ""
for { set i 0 } { $i < [string length $str] } { incr i } {
if {[string range $str $i $i] == "\[" &&
[string length $str] > [expr {$i 3}] &&
[string range $str [expr {$i 3}] [expr {$i 3}]] == "\]" } {
set d1 [string range $str [expr {$i 1}] [expr {$i 1}]]
set d2 [string range $str [expr {$i 2}] [expr {$i 2 }]]
if {([string is digit $d1] || $d1 == "a" || $d1 == "b" ||
$d1 == "c" || $d1 == "d" || $d1 == "e" || $d1 == "f") ||
([string is digit $d2] || $d2 == "a" || $d2 == "b" ||
$d2 == "c" || $d2 == "d" || $d2 == "e" || $d2 == "f")} {
append out [binary format H* "${d1}${d2}"]
incr i 3
} else {
append out "\[${d1}${d2}\]"
}
} else {
append out [string range $str $i $i]
}
}
return $out
}
proc hex_to_string { hex } {
return [string map { "\[" "" "\]" "" } $hex]
}
proc hexdump {str} {
return [hex_to_string [hexify_all $str]]
}
proc read_key { fd } {
set key(offset) [expr {[tell $fd] - 16}]
set data [read $fd 5]
#puts "Reading key at $key(offset) : [hexdump $data]"
if {[hexdump $data] == "AABBCCDDEE" } {
puts "Found end marker for keys"
return [list]
}
binary scan $data SSc unknown length type
set string [read $fd $length]
set del [read $fd 1]
if {$del != "\x00" } {
puts "WARNING: Key delimiter at offset $key(offset) is not 0 : 0x[hexdump $del]"
}
set key(key_unk) $unknown
set key(key_type) $type
set key(key) $string
return [array get key]
}
proc read_value { fd } {
set data [read $fd 9]
binary scan $data ISSc offset unknown length type
#puts "Reading value at $offset : [hexdump $data]"
if {[hexdump [string range $data 0 4]] == "AABBCCDDEE" } {
puts "Found end marker for values"
return [list]
}
set content [read $fd $length]
set del [read $fd 1]
if {$del != "\x00" } {
puts "WARNING: Value delimiter at offset $offset is not 0 : 0x[hexdump $del]"
}
set value(offset) $offset
set value(value_unk) $unknown
set value(value_type) $type
set value(length) $length
set value(content) $content
return [array get value]
}
proc build_ui { } {
global registry
set w_offset .f.f0.list
set w_key .f.f1.list
set w_key_type .f.f2.list
set w_value_type .f.f3.list
set w_length .f.f4.list
set w_content .f.f5.list
frame .f
frame .f.f0
pack [label .f.f0.header -bg grey -text "Offset"] -expand false -fill x -padx 2
pack [listbox .f.f0.list -yscrollcommand "scroll_y list" -width 6] -expand true -fill both
pack .f.f0 -side left -expand false -fill both
frame .f.f1
pack [label .f.f1.header -bg grey -text "Key"] -expand false -fill x -padx 2
pack [listbox .f.f1.list -yscrollcommand "scroll_y list" -width 50] -expand true -fill both
pack .f.f1 -side left -expand false -fill both
frame .f.f2
pack [label .f.f2.header -bg grey -text "Key type"] -expand false -fill x -padx 2
pack [listbox .f.f2.list -yscrollcommand "scroll_y list" -width 1] -expand true -fill both
pack .f.f2 -side left -expand false -fill both
frame .f.f3
pack [label .f.f3.header -bg grey -text "Value type"] -expand false -fill x -padx 2
pack [listbox .f.f3.list -yscrollcommand "scroll_y list" -width 1] -expand true -fill both
pack .f.f3 -side left -expand false -fill both
frame .f.f4
pack [label .f.f4.header -bg grey -text "Length"] -expand false -fill x -padx 2
pack [listbox .f.f4.list -yscrollcommand "scroll_y list" -width 3] -expand true -fill both
pack .f.f4 -side left -expand false -fill both
frame .f.f5
pack [label .f.f5.header -bg grey -text "Value"] -expand false -fill x -padx 2
pack [listbox .f.f5.list -yscrollcommand "scroll_y list"] -expand true -fill both
pack .f.f5 -side left -expand true -fill both
proc ::scroll_y { from arg1 arg2 } {
if {$from == "list" } {
set start $arg1
set end $arg2
for {set i 0} {$i <= 5} {incr i} {
.f.f$i.list yview moveto $start
}
.scroll_y set $start $end
} elseif {$from == "scroll"} {
set start $arg2
.f.f0.list yview moveto $start
foreach {start end} [.f.f0.list yview] break
for {set i 0} {$i <= 5} {incr i} {
.f.f$i.list yview moveto $start
}
.scroll_y set $start $end
}
}
scrollbar .scroll_y -command "scroll_y scroll" -highlightthickness 0 \
-borderwidth 1 -elementborderwidth 2
pack .scroll_y -side right -expand false -fill y
pack .f -side right -expand true -fill both
#pack .scroll_x -side bottom -expand true -fill x
set offsets [lsort -integer [array names registry]]
foreach offset $offsets {
array set data [set registry($offset)]
catch {unset key}
catch {unset content}
if {[info exists data(key)] } {
set key $data(key)
set key_unk $data(key_unk)
set key_type $data(key_type)
}
if {[info exists data(content)] } {
set length $data(length)
set content $data(content)
set value_type $data(value_type)
set value_unk $data(value_unk)
set trimmed_content [string trim $content "\x00"]
if {$trimmed_content == ""} {
set trimmed_content "\x00"
}
set content_to_show [hexify $trimmed_content]
}
$w_offset insert end "[format 0x%0.4X $offset]"
if {![info exists key] } {
$w_key insert end "N/A"
$w_key itemconfigure end -background red
$w_key_type insert end "N/A"
$w_key_type itemconfigure end -background red
} else {
$w_key insert end "$key"
$w_key_type insert end "$key_type"
}
if {![info exists content] } {
$w_value_type insert end "N/A"
$w_value_type itemconfigure end -background red
$w_length insert end "N/A"
$w_length itemconfigure end -background red
$w_content insert end "N/A"
$w_content itemconfigure end -background red
} else {
$w_value_type insert end "$value_type"
$w_length insert end "$length"
$w_content insert end "$content_to_show"
}
}
}
if {[llength $argv] != 1} {
puts "Usage: registry.tcl /path/to/xRegistry.sys"
exit
}
set filename [lindex $argv 0]
if { [catch {set fd [open $filename]}] } {
puts "File not found"
exit
}
fconfigure $fd -translation binary
set header [read $fd 16]
if {[hexdump $header] != "BCADADBC0000009500000002BCADADBC"} {
puts "Wrong file format : [hexdump $header]"
exit
}
global registry
while {1} {
set key [read_key $fd]
if {$key == [list] } {
break
}
catch {unset data}
array set data $key
set offset $data(offset)
set registry($offset) $key
}
seek $fd [expr 0x10000] start
while {1} {
set value [read_value $fd]
if {$value == [list] } {
break;
}
catch {unset data}
array set data $value
set offset $data(offset)
array set data [set registry($offset)]
set registry($offset) [array get data]
}
build_ui