Skip to content

fix safe_string problems and compile OCaml programs with safe_string #7

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
ilyasergey merged 1 commit into from
Dec 2, 2017
Merged

fix safe_string problems and compile OCaml programs with safe_string #7

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions Makefile
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,9 +17,9 @@ Makefile.coq: _CoqProject
coq_makefile -f _CoqProject -o Makefile.coq

TPCMain.d.byte: default
ocamlbuild -libs unix -I extraction/TPC -I shims shims/TPCMain.d.byte
ocamlbuild -tag safe_string -libs unix -I extraction/TPC -I shims shims/TPCMain.d.byte

CalculatorMain.d.byte: default
ocamlbuild -libs unix -I extraction/calculator -I shims shims/CalculatorMain.d.byte
ocamlbuild -tag safe_string -libs unix -I extraction/calculator -I shims shims/CalculatorMain.d.byte

.PHONY: default clean install
21 changes: 12 additions & 9 deletions shims/Shim.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,8 @@ let get_addr_port cfg name =
let get_name_for_read_fd fd =
Hashtbl.find read_fds fd

let send_chunk (fd : file_descr) (buf : string) : unit =
let len = String.length buf in
let send_chunk (fd : file_descr) (buf : bytes) : unit =
let len = Bytes.length buf in
(* Printf.printf "sending chunk of length %d" len; print_newline (); *)
let n = Unix.send fd (Util.raw_bytes_of_int len) 0 4 [] in
if n < 4 then
Expand Down Expand Up @@ -64,8 +64,9 @@ let get_write_fd name =
let (ip, port) = get_addr_port cfg name in
let entry = gethostbyname ip in
let node_addr = ADDR_INET (Array.get entry.h_addr_list 0, port) in
let chunk = Bytes.of_string (string_of_nat cfg.me) in
connect write_fd node_addr;
send_chunk write_fd (string_of_nat cfg.me);
send_chunk write_fd chunk;
Hashtbl.add write_fds name write_fd;
write_fd

Expand All @@ -84,10 +85,11 @@ let new_conn () =
print_endline "new connection!";
let (node_fd, node_addr) = accept listen_fd in
let chunk = receive_chunk node_fd in
let node_name = nat_of_string chunk in
Hashtbl.add read_fds node_fd node_name;
(* ignore (get_write_fd node_name); *)
Printf.printf "done processing new connection from node %s" chunk;
let node = Bytes.to_string chunk in
let name = nat_of_string node in
Hashtbl.add read_fds node_fd name;
(* ignore (get_write_fd name); *)
Printf.printf "done processing new connection from node %s" node;
print_newline ()

let check_for_new_connections () =
Expand All @@ -107,7 +109,7 @@ let deserialize_msg s =

let recv_msg fd =
let chunk = receive_chunk fd in
let (l, tag, msg) = deserialize_msg chunk in
let (l, tag, msg) = deserialize_msg (Bytes.to_string chunk) in
let src = get_name_for_read_fd fd in
Printf.printf "got msg in protocol %a with tag = %a, contents = %a from %s" print_nat l print_nat tag (print_list print_nat) msg (string_of_nat src);
print_newline ();
Expand All @@ -118,7 +120,8 @@ let send_msg l dst tag msg =
print_newline ();
let fd = get_write_fd dst in
let s = serialize_msg l tag msg in
send_chunk fd s
let chunk = Bytes.of_string s in
send_chunk fd chunk

let get_current_state () =
let cfg = get_cfg "get_current_sate" in
Expand Down