Skip to content

Commit 8ad2594

Browse files
committed
CHB: add result types for reading binary
1 parent 0b69ad3 commit 8ad2594

File tree

7 files changed

+238
-138
lines changed

7 files changed

+238
-138
lines changed

CodeHawk/CHB/bchlib/bCHLibTypes.mli

Lines changed: 23 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6232,9 +6232,29 @@ object
62326232
method get_preamble_cutoff: int
62336233
method get_filename: string
62346234
method get_xfilesize: int
6235-
method get_file_string: ?hexSize:doubleword_int -> doubleword_int -> string
6235+
6236+
(** [get_file_string size offset] returns the segment from the input binary
6237+
that starts at file offset [offset] of length [size]. If [size] is zero
6238+
the remainder of the file is returned starting at [offset].
6239+
6240+
An error is returned if [offset] is larger than the size of the binary
6241+
or if [offset + size] is more than 10 bytes beyond the end of the file
6242+
(if it is less than 10 bytes beyond the end of the file, the remainder
6243+
is padded with zero's to make up the requested length).
6244+
*)
6245+
method get_file_string:
6246+
?hexSize:doubleword_int -> doubleword_int -> string traceresult
6247+
6248+
(** [get_file_input size offset] returns a wrapper around a segment from
6249+
the input binary to facilitate reading different types from the string.
6250+
6251+
Errors returned are the same as for [get_file_string].
6252+
*)
62366253
method get_file_input:
6237-
?hexSize:doubleword_int -> doubleword_int -> stream_wrapper_int
6254+
?hexSize:doubleword_int
6255+
-> doubleword_int
6256+
-> stream_wrapper_int traceresult
6257+
62386258
method get_image_base: doubleword_int
62396259
method get_base_of_code_rva: doubleword_int (* relative virtual address *)
62406260
method get_address_of_entry_point: doubleword_int
@@ -6314,6 +6334,7 @@ object
63146334

63156335
(* xml *)
63166336
(* method read_xml_constant_file: string -> unit *)
6337+
method read_xml_user_data: xml_element_int -> unit
63176338

63186339
(* saving *)
63196340
method write_xml: xml_element_int -> unit

CodeHawk/CHB/bchlib/bCHSystemInfo.ml

Lines changed: 47 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ open CHUtils
4949
(* chutil *)
5050
open CHLogger
5151
open CHPrettyUtil
52+
open CHTraceResult
5253
open CHXmlDocument
5354
open CHXmlReader
5455

@@ -673,7 +674,7 @@ object (self)
673674
end
674675
| _ -> ()
675676

676-
method private read_xml_user_data (node:xml_element_int) =
677+
method read_xml_user_data (node:xml_element_int) =
677678
let get = node#getAttribute in
678679
let has = node#hasNamedAttribute in
679680
let getc = node#getTaggedChild in
@@ -1864,9 +1865,14 @@ object (self)
18641865

18651866
method get_size = String.length !file_as_string
18661867

1867-
method get_file_input ?(hexSize=wordzero) (hexOffset:doubleword_int) =
1868-
let fString = self#get_file_string ~hexSize hexOffset in
1869-
file_stream_wrapper_function (IO.input_string fString)
1868+
method get_file_input
1869+
?(hexSize=wordzero)
1870+
(hexOffset:doubleword_int): stream_wrapper_int traceresult =
1871+
let fString_r = self#get_file_string ~hexSize hexOffset in
1872+
TR.tmap
1873+
~msg:(__FILE__ ^ ":" ^ (string_of_int __LINE__))
1874+
(fun s -> file_stream_wrapper_function (IO.input_string s))
1875+
fString_r
18701876

18711877
method private get_encodings (va:doubleword_int) (len:int) =
18721878
let encoding_to_pretty (ty, va, size, key, width) =
@@ -1894,30 +1900,19 @@ object (self)
18941900
| [] -> s
18951901
| encodings -> decode_string s va encodings
18961902

1897-
method get_file_string ?(hexSize=wordzero) (hexOffset:doubleword_int) =
1903+
method get_file_string
1904+
?(hexSize=wordzero) (hexOffset:doubleword_int): string traceresult =
18981905
let offset = hexOffset#to_int in
18991906
let size = hexSize#to_int in
19001907
let len = String.length !file_as_string in
19011908
if size > 0 then
19021909
if offset > len then
1903-
let hexLen =
1904-
fail_tvalue
1905-
(trerror_record
1906-
(LBLOCK [
1907-
STR "system_info:get_file_string:hexLen: "; INT len]))
1908-
(int_to_doubleword len) in
1909-
begin
1910-
ch_error_log#add
1911-
"invalid argument"
1912-
(LBLOCK [
1913-
STR "Unable to return input at offset ";
1914-
hexOffset#toPretty;
1915-
STR " -- file size = ";
1916-
hexLen#toPretty ]);
1917-
raise
1918-
(Invalid_argument
1919-
"assembly_xreference_t#get_exe_string_at_offset")
1920-
end
1910+
Error [
1911+
__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
1912+
^ "Unable to return input at offset "
1913+
^ (string_of_int size)
1914+
^ "; file size is "
1915+
^ (string_of_int len)]
19211916
else
19221917
if offset + size > len then
19231918
let sizeAvailable = len - offset in
@@ -1934,18 +1929,19 @@ object (self)
19341929
STR " and filling up the rest with zeroes"]);
19351930
if len > offset then
19361931
let missing = Bytes.make (size - sizeAvailable) (Char.chr 0) in
1937-
String.concat
1938-
""
1939-
[string_suffix !file_as_string offset;
1940-
Bytes.to_string missing]
1932+
Ok (String.concat
1933+
""
1934+
[string_suffix !file_as_string offset;
1935+
Bytes.to_string missing])
19411936
else
1942-
raise (BCH_failure
1943-
(LBLOCK [
1944-
STR "get-file-string (error case): ";
1945-
STR "String.suffix: Length: ";
1946-
INT len;
1947-
STR "; offset: ";
1948-
INT offset]))
1937+
Error [
1938+
__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
1939+
^ "Unable to return input of size "
1940+
^ (string_of_int size)
1941+
^ " at offset "
1942+
^ (string_of_int offset)
1943+
^ "; sum exceeds file size of "
1944+
^ (string_of_int len)]
19491945
end
19501946
else
19511947
begin
@@ -1957,29 +1953,29 @@ object (self)
19571953
STR "only returning ";
19581954
INT sizeAvailable]);
19591955
if len > offset then
1960-
string_suffix !file_as_string offset
1956+
Ok (string_suffix !file_as_string offset)
19611957
else
1962-
raise (BCH_failure
1963-
(LBLOCK [
1964-
STR "get-file-string (error case): ";
1965-
STR "String.suffix: Length: ";
1966-
INT len;
1967-
STR "; offset: ";
1968-
INT offset]))
1958+
Error [
1959+
__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
1960+
^ "Unable to return input of size "
1961+
^ (string_of_int size)
1962+
^ " at offset "
1963+
^ (string_of_int offset)
1964+
^ "; sum exceeds file size of "
1965+
^ (string_of_int len)]
19691966
end
19701967
else
1971-
String.sub !file_as_string offset size
1968+
Ok (String.sub !file_as_string offset size)
19721969
else
19731970
if len > offset then
1974-
string_suffix !file_as_string offset
1971+
Ok (string_suffix !file_as_string offset)
19751972
else
1976-
raise
1977-
(BCH_failure
1978-
(LBLOCK [
1979-
STR "get-file-string: String.suffix: Length: ";
1980-
INT len;
1981-
STR "; offset: ";
1982-
INT offset]))
1973+
Error [
1974+
__FILE__ ^ ":" ^ (string_of_int __LINE__) ^ ": "
1975+
^ "Unable to return file input suffix. Offset "
1976+
^ (string_of_int offset)
1977+
^ " exceeds file size "
1978+
^ (string_of_int offset)]
19831979

19841980
method set_image_base (a:doubleword_int) =
19851981
begin image_base <- a ; system_data#set_image_base a end

CodeHawk/CHB/bchlibelf/bCHELFHeader.ml

Lines changed: 56 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
77
Copyright (c) 2005-2020 Kestrel Technology LLC
88
Copyright (c) 2020 Henny Sipma
9-
Copyright (c) 2021-2024 Aarno Labs LLC
9+
Copyright (c) 2021-2025 Aarno Labs LLC
1010
1111
Permission is hereby granted, free of charge, to any person obtaining a copy
1212
of this software and associated documentation files (the "Software"), to deal
@@ -209,7 +209,16 @@ object
209209

210210

211211
method read =
212-
let input = system_info#get_file_input (TR.tget_ok (int_to_doubleword 16)) in
212+
let input_r = system_info#get_file_input (TR.tget_ok (int_to_doubleword 16)) in
213+
match input_r with
214+
| Error e ->
215+
raise
216+
(BCH_failure
217+
(LBLOCK [
218+
STR __FILE__; STR ":"; INT __LINE__; STR ": ";
219+
STR "Unable to read elf file header from binary: ";
220+
STR (String.concat "; " e)]))
221+
| Ok input ->
213222
begin
214223
(* 16, 2 --------------------------------------------------------------
215224
Specifies the object file type.
@@ -429,8 +438,16 @@ object(self)
429438
method get_program_entry_point = elf_file_header#get_program_entry_point
430439

431440
method read =
432-
let fileString = system_info#get_file_string wordzero in
433-
let input = IO.input_string fileString in
441+
let fileString_r = system_info#get_file_string wordzero in
442+
let input =
443+
match fileString_r with
444+
| Ok s -> IO.input_string s
445+
| Error e ->
446+
raise
447+
(BCH_failure
448+
(LBLOCK [STR __FILE__; STR ":"; INT __LINE__; STR ": ";
449+
STR "Unable to read elf header: ";
450+
STR (String.concat "; " e)])) in
434451
begin
435452
e_ident <- Bytes.to_string (IO.really_nread input 16);
436453
self#check_elf;
@@ -1163,7 +1180,7 @@ object(self)
11631180
end
11641181
done
11651182

1166-
method private add_new_user_defined_section_headers =
1183+
method add_new_user_defined_section_headers =
11671184
(* let shnum = elf_file_header#get_section_header_table_entry_num in *)
11681185
let shnum = H.length section_header_table in
11691186
try
@@ -1202,35 +1219,61 @@ object(self)
12021219
else
12031220
if H.mem section_header_table index then
12041221
let sh = H.find section_header_table index in
1205-
let xString =
1222+
let xString_r =
12061223
if sh#get_size#equal wordzero then
1207-
""
1224+
Ok ""
12081225
else
12091226
system_info#get_file_string ~hexSize:sh#get_size sh#get_offset in
1210-
let section = make_elf_section sh xString in
1227+
let section =
1228+
match xString_r with
1229+
| Ok s -> make_elf_section sh s
1230+
| Error e ->
1231+
raise
1232+
(BCH_failure
1233+
(LBLOCK [
1234+
STR __FILE__; STR ":"; INT __LINE__; STR ": ";
1235+
STR "Unable to read section with index ";
1236+
INT index;
1237+
STR ": ";
1238+
STR (String.concat "; " e)])) in
12111239
H.add section_table index section
12121240
else
12131241
raise
12141242
(BCH_failure
1215-
(LBLOCK [STR "No section header found for "; INT index]))
1243+
(LBLOCK [
1244+
STR __FILE__; STR ":"; INT __LINE__; STR ": ";
1245+
STR "No section header found for "; INT index]))
12161246

12171247
method private add_segment (index:int) =
12181248
if H.mem segment_table index then
12191249
()
12201250
else
12211251
if H.mem program_header_table index then
12221252
let ph = H.find program_header_table index in
1223-
let xString =
1253+
let xString_r =
12241254
if ph#get_file_size#equal wordzero then
1225-
""
1255+
Ok ""
12261256
else
12271257
system_info#get_file_string ~hexSize:ph#get_file_size ph#get_offset in
1228-
let segment = make_elf_segment ph xString in
1258+
let segment =
1259+
match xString_r with
1260+
| Ok s -> make_elf_segment ph s
1261+
| Error e ->
1262+
raise
1263+
(BCH_failure
1264+
(LBLOCK [
1265+
STR __FILE__; STR ":"; INT __LINE__; STR ": ";
1266+
STR "Unable to read segment with index ";
1267+
INT index;
1268+
STR ": ";
1269+
STR (String.concat "; " e)])) in
12291270
H.add segment_table index segment
12301271
else
12311272
raise
12321273
(BCH_failure
1233-
(LBLOCK [STR "No segment header found for index "; INT index]))
1274+
(LBLOCK [
1275+
STR __FILE__; STR ":"; INT __LINE__; STR ": ";
1276+
STR "No segment header found for index "; INT index]))
12341277

12351278
method private write_xml_program_headers (node:xml_element_int) =
12361279
let headers = ref [] in

0 commit comments

Comments
 (0)