Initial commit 2

3 files changed, 137 insertions, 9 deletions

diff --git a/.gitignore b/.gitignore
index fea4c45..60db691 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,9 +1,3 @@
-*.annot
-*.cmo
-*.cma
-*.cmi
-*.a
-*.o
-*.cmx
-*.cmxs
-*.cmxa
+_build
+*.native
+*.byte
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..169098d
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,8 @@
+build:
+	ocamlbuild witch.byte -libs unix
+
+native:
+	ocamlbuild witch.native -libs unix
+
+clean:
+	rm -rf _build witch.native witch.byte
diff --git a/witch.ml b/witch.ml
new file mode 100644
index 0000000..f335099
--- /dev/null
+++ b/witch.ml
@@ -0,0 +1,126 @@
+open Sys
+open Unix
+
+let try_finalize f x finally y =
+  let res = try f x with exn -> finally y; raise exn in
+  finally y;
+  res
+
+let exec cmd = execvp cmd.(0) cmd
+
+let launch cmd =
+  if fork () = 0
+  then exec cmd
+
+let print_usage () =
+  List.iter print_endline ["Usage: " ^ Sys.argv.(0) ^ " <title>"];
+  exit 0
+
+let die reason =
+  print_endline ("ERROR! " ^ reason); exit (-1)
+
+let launch_get_output cmd  =
+  let input_lines ic =
+    let rec aux lines =
+      try aux (input_line ic :: lines) with End_of_file -> lines in
+    aux [] in
+  let (ifd,ofd) = pipe () in
+  match fork () with
+  | 0 -> dup2 ofd stdout; dup2 ofd stderr;
+         close stdin; close ifd; close ofd;
+         exec cmd
+  | n -> close ofd;
+         let lns = input_lines (in_channel_of_descr ifd) in
+         close ifd; ignore (waitpid [] n);
+         lns
+
+module Net = struct
+  let tcp_server s_handler addr =
+    let setup_tcp_socket addr =
+      let s = socket PF_INET SOCK_STREAM 0 in
+      try bind s addr;
+          listen s 10;
+          s
+      with z -> close s; raise z in
+    ignore (signal sigpipe Signal_ignore);
+    let ss = setup_tcp_socket addr in
+    while true do
+      let client = accept ss in
+      s_handler ss client
+    done
+
+  let double_fork server service (cfd, _ as client) =
+    let treat () = match fork () with
+      | 0 -> if fork () <> 0 then exit 0;
+             close server; service client; exit 0
+      | n -> ignore (waitpid [] n) in
+    try_finalize treat () close cfd
+
+  let s_handler c_handler sock (_, caddr as client) =
+    print_endline
+      (match caddr with
+       | ADDR_INET (a,_) -> "Connected to " ^ string_of_inet_addr a
+       | ADDR_UNIX _     -> "Local connection (dafuq?)");
+    double_fork sock c_handler client
+end
+
+module type XWIN = sig
+    type wid
+    val cmdname : string
+
+    val search_by_title : string -> wid list
+    val title : wid -> string
+    val focus : wid -> unit
+    val send : wid -> string -> unit
+end
+module Xdotool : (XWIN with type wid := string) = struct
+  let cmdname = "xdotool"
+  let delay = "200"
+
+  let search_by_title name =
+    launch_get_output [|cmdname; "search"; "--name"; name|]
+  let title wid =
+    List.hd (launch_get_output [|cmdname; "getwindowname"; wid|])
+  let focus wid =
+    launch [|cmdname; "windowfocus"; wid|]
+  let send wid keys =
+    launch [|cmdname; "type"; "--delay"; delay; keys|]
+end
+
+module Comm = struct
+  module Window = Xdotool
+
+  let get_wid name =
+    let wids = Window.search_by_title name in
+    let falses = [Sys.argv.(0); "mednafen"] in (* May have the same title *)
+    let falsewids = List.concat (List.map Window.search_by_title falses) in
+    match List.filter (fun wid -> not (List.mem wid falsewids)) wids with
+    | [x] -> Some (x, Window.title x)
+    | _   -> None
+
+  let c_handler wid (cfd, _) =
+    dup2 cfd stdin; dup2 cfd stdout; dup2 cfd stderr; close cfd;
+    Window.focus wid;
+    while true do
+      print_string "> ";
+      flush_all ();
+      let l = read_line () in
+      Window.send wid l;
+    done
+    (* Window.send wid "awdwawdwawdwawdwa" *)
+    (* Window.send wid "aaaaaaaaaaaaaaaaa" *)
+end
+
+let () =
+  if Array.length Sys.argv <> 2 then print_usage ();
+
+  let addr = inet_addr_any in
+  let port = 8081 in
+  let inaddr = ADDR_INET (addr, port) in
+  let name = Sys.argv.(1) in
+
+  match Comm.get_wid name with
+  | None              -> die ("Window '" ^ name ^ "' not found")
+  | Some (wid, title) ->
+     print_endline ("Found window '" ^ title ^ "' (WID " ^ wid ^ ")");
+     Net.tcp_server (Net.s_handler (Comm.c_handler wid)) inaddr