initial commit

.gitignore

@@ -0,0 +1,2 @@
+/bridge.conf
+/_build

README.md

@@ -0,0 +1,3 @@
+# ignore this
+
+spaghet code

dune

@@ -0,0 +1,8 @@
+(executable
+  (name factorio_bridge)
+  (libraries core async async_ssl
+             bitstring
+             cohttp-async
+             caqti-async caqti-driver-sqlite3
+             yojson)
+  (preprocess (pps ppx_bitstring ppx_jane)))

dune-project

@@ -0,0 +1 @@
+(lang dune 2.9)

factorio-bridge.service

@@ -0,0 +1,12 @@
+[Unit]
+Description=factorio-matrix bridge
+Requires=factorio.service
+After=factorio.service
+
+[Service]
+ExecStart=/opt/factorio-bridge/factorio_bridge.exe -config /opt/factorio-bridge/bridge.conf
+RestartSec=5s
+StandardInput=socket
+
+[Install]
+WantedBy=default.target

factorio-bridge.socket

@@ -0,0 +1,9 @@
+[Unit]
+Description=Factorio bridge socket
+
+[Socket]
+ListenFIFO=/var/lib/factorio/console.log
+SocketMode=0666
+
+[Install]
+WantedBy=sockets.target

factorio_bridge.ml

@@ -0,0 +1,275 @@
+open Core
+open Async
+
+(* let run ~uppercase ~port = *)
+(*   let host_and_port = *)
+(*     Tcp.Server.create ~on_handler_error:`Raise *)
+(*       (Tcp.Where_to_listen.of_port port) (fun _addr r w -> *)
+(*         Pipe.transfer (Reader.pipe r) (Writer.pipe w) *)
+(*           ~f:(if uppercase then String.uppercase else Fn.id)) *)
+(*   in *)
+(*   ignore (host_and_port : (Socket.Address.Inet.t, int) Tcp.Server.t Deferred.t); *)
+(*   Deferred.never () *)
+(*  *)
+(* let () = *)
+(*   Command.async ~summary:"Start an echo server" *)
+(*     Command.Let_syntax.( *)
+(*       let%map_open uppercase = *)
+(*         flag "-uppercase" no_arg *)
+(*           ~doc:" Convert to uppercase before echoing back" *)
+(*       and port = *)
+(*         flag "-port" *)
+(*           (optional_with_default 8765 int) *)
+(*           ~doc:" Port to listen on (default 8765)" *)
+(*       in *)
+(*       fun () -> run ~uppercase ~port) *)
+(*   |> Command.run *)
+
+(* let query_uri query = *)
+(*     let base_uri = Uri.of_string "http://api.duckduckgo.com/?format=json" in *)
+(*     Uri.add_query_param base_uri ("q", [query]) *)
+(*  *)
+(* let get_definition word = *)
+(*     let%bind (_, body) = Cohttp_async.Client.get (query_uri word) in *)
+(*     let%map str = Cohttp_async.Body.to_string body in *)
+(*     printf "result: %s\n" str *)
+(*  *)
+(* let () = *)
+(*     ignore (get_definition "cat"); *)
+(*     never_returns (Scheduler.go ()) *)
+
+let sqlite3_base = (Uri.of_string "sqlite3:///")
+
+type bridge_config = {
+  matrix_homeserver: string;
+  matrix_username: string;
+  matrix_password: string;
+  matrix_channel: string;
+  factorio_rcon_host: string;
+  factorio_rcon_port: int;
+  factorio_rcon_password: string;
+} [@@deriving sexp]
+
+exception MatrixParsingError of string [@@deriving sexp]
+
+let caqti_or_error res =
+  match res with
+  | Ok x -> return x
+  | Error (#Caqti_error.t as err) ->
+      Error.raise (Error.of_exn (Caqti_error.Exn err))
+
+(* let main ~dbpath = *)
+(*   let%bind pool = *)
+(*     Caqti_async.connect_pool (Uri.with_path sqlite3_base dbpath) |> caqti_or_error *)
+(*   in *)
+(*   let query = *)
+(*     Caqti_request.exec *)
+(*       Caqti_type.unit *)
+(*       {| CREATE TABLE test (id INTEGER PRIMARY KEY) |} in *)
+(*   let%bind _ = *)
+(*     (Caqti_async.Pool.use *)
+(*       (fun (module C : Caqti_async.CONNECTION) -> C.exec query ()) *)
+(*       pool) >>= caqti_or_error in *)
+(*   return () *)
+
+let json_find key json =
+  match json with
+  | `Assoc items ->
+      List.Assoc.find ~equal:String.(=) items key
+  | _ -> raise (MatrixParsingError (sprintf "no key %s" key))
+
+let matrix_login ~homeserver ~username ~password =
+  let uri = Uri.with_path homeserver "/_matrix/client/r0/login" in
+  let body = Yojson.to_string
+    (`Assoc [ ("type", `String "m.login.password"); ("user", `String username);
+              ("password", `String password) ])
+  in
+  let%bind (_, body) = Cohttp_async.Client.post ?body:(Some (Cohttp_async.Body.of_string body)) uri in
+  let%bind str = Cohttp_async.Body.to_string body in
+  match json_find "access_token" (Yojson.Safe.from_string str) with
+  | Some(`String token) -> return token
+  | _ -> raise (MatrixParsingError str)
+
+let matrix_send ~homeserver ~token ~channel message =
+  let uri = Uri.with_path homeserver
+                          (sprintf "/_matrix/client/r0/rooms/%s/send/m.room.message" channel) in
+  let uri = Uri.add_query_param uri ("access_token", [token]) in
+  let body = Yojson.to_string
+    (`Assoc [ ("msgtype", `String "m.text"); ("body", `String message) ]) in
+  let%bind (_, body) = Cohttp_async.Client.post ?body:(Some (Cohttp_async.Body.of_string body)) uri in
+  let%bind str = Cohttp_async.Body.to_string body in
+  ignore str; return ()
+
+let matrix_get_next_batch json =
+  match json_find "next_batch" json with
+  | Some(`String str) -> str
+  | _ -> raise (MatrixParsingError "no next_batch")
+
+let matrix_get_message_events (json : Yojson.Safe.t) : Yojson.Safe.t list =
+  let join_rooms : (string * Yojson.Safe.t) list =
+    match Option.Monad_infix.(json_find "rooms" json >>= json_find "join") with
+    | Some(`Assoc items) -> items
+    | _ -> []
+  in
+  let fold_messages (acc : Yojson.Safe.t list) ((room_name : string), (room_state : Yojson.Safe.t))
+      : Yojson.Safe.t list =
+    ignore room_name;
+    match Option.Monad_infix.(json_find "timeline" room_state >>= json_find "events") with
+    | Some(`List event_objects) ->
+        acc @ (List.fold_left event_objects ~init:[]
+                  ~f:(fun (acc : Yojson.Safe.t list) (a : Yojson.Safe.t) : Yojson.Safe.t list ->
+                    match json_find "type" a with
+                    | Some(`String "m.room.message") -> a::acc
+                    | _ -> acc))
+    | _ -> acc
+  in List.fold_left join_rooms ~init:[] ~f:fold_messages
+
+let matrix_get_body (json : Yojson.Safe.t) : string =
+  Option.Monad_infix.(
+    match json_find "content" json >>= json_find "body" with
+    | Some(`String x) -> x
+    | _ -> "<unrecognized matrix message>")
+
+let matrix_get_sender (json : Yojson.Safe.t) : string =
+  match json_find "sender" json with
+  | Some(`String x) -> x
+  | _ -> "<unknown matrix sender>"
+
+let matrix_sync_with ~homeserver ~token ~(since : string option) =
+  (* printf "syncing with state: %s\n" (match since with | Some x -> x | None -> "<None>"); *)
+  let first_filter = "{\"room\":{\"timeline\":{\"limit\":1}}}" in
+  let uri = Uri.with_path homeserver "/_matrix/client/r0/sync" in
+  let uri =
+    match since with
+    | Some since -> Uri.add_query_param uri ("since", [since])
+    | None -> Uri.add_query_param uri ("filter", [first_filter])
+  in
+  let uri = Uri.add_query_param uri ("access_token", [token]) in
+  let uri = Uri.add_query_param uri ("timeout", ["10000"]) in
+  let%bind (_, body) = Cohttp_async.Client.get uri in
+  let%bind str = Cohttp_async.Body.to_string body in
+  let json = Yojson.Safe.from_string str in
+  let next_batch = matrix_get_next_batch json in
+  let message_events = matrix_get_message_events json in
+  return (message_events, next_batch)
+
+let matrix_message_stream ~homeserver ~token ~(state : string option)
+    : Yojson.Safe.t Pipe.Reader.t =
+  let rec write_to_pipe (lst : Yojson.Safe.t list) (writer : Yojson.Safe.t Pipe.Writer.t) =
+    match lst with
+    | [] -> return ()
+    | item::rest -> let%bind () = Pipe.write writer item in write_to_pipe rest writer
+  in let rec writer_func state writer =
+    let%bind (message_events, next_state) = matrix_sync_with ~homeserver ~token ~since:state in
+    let%bind () = write_to_pipe message_events writer in
+    writer_func (Some(next_state)) writer
+  in
+  Pipe.create_reader ~close_on_exception:false (writer_func state)
+
+let rcon_writer ~(host : string) ~(port : int) ~(password : string) : string Pipe.Writer.t =
+  let reader_func pipe_reader =
+    let%bind (socket, reader, writer) =
+      Tcp.connect (Tcp.Where_to_connect.of_host_and_port {host; port;})
+    in
+    ignore socket;
+    let send_packet (id : int) (typ : int) (body : string) =
+      let body = String.concat [body; "\x00\x00"] in
+      let id = Int32.of_int_exn id in
+      let typ = Int32.of_int_exn typ in
+      let%bitstring body_part = {|
+        id : 32 : littleendian;
+        typ : 32 : littleendian;
+        body : -1 : string
+      |} in
+      let body_part = Bitstring.string_of_bitstring body_part in
+      let size = String.length body_part |> Int32.of_int_exn in
+      let%bitstring full_body = {|
+        size : 32 : littleendian;
+        body_part : -1 : string
+      |} in
+      let () = Writer.write writer (Bitstring.string_of_bitstring full_body) in
+      Writer.flushed writer
+    in
+    let recv_packet () =
+      let size_bytes = Char.of_int_exn 0 |> Bytes.make 4 in
+      let%bind _ = Reader.really_read reader size_bytes in
+      let size_str = Bytes.to_string size_bytes in
+      let size_str = Bitstring.bitstring_of_string size_str in
+      let size = match%bitstring size_str with | {| size : 32 : littleendian |} -> size in
+      let size = Int32.to_int_exn size in
+      let rest = Char.of_int_exn 0 |> Bytes.make size in
+      let%bind _ = Reader.really_read reader rest in
+      let rest = Bytes.to_string rest |> Bitstring.bitstring_of_string in
+      match%bitstring rest with
+      | {| id : 32 : littleendian; typ : 32 : littleendian; content : -1 : string |} ->
+          return (Int32.to_int_exn id, Int32.to_int_exn typ, content)
+    in
+    let login () =
+      let%bind () = send_packet 1 3 password in
+      match%bind recv_packet () with
+      | (1, 2, _) -> return ()
+      | _ -> failwith "failed to log into rcon"
+    in
+    let%bind () = login () in
+    let%bind _ = Pipe.fold pipe_reader ~init:2 ~f:(fun packet_id message ->
+      let%bind () = send_packet packet_id 2 message in
+      let%bind (_, _, _) = recv_packet () in
+      return (packet_id + 1)) in
+    return ()
+  in
+  Pipe.create_writer reader_func
+
+
+let main ~dbpath ~config =
+  ignore dbpath;
+  let conf = bridge_config_of_sexp (Sexp.load_sexp config) in
+  let writer =
+    rcon_writer ~host:conf.factorio_rcon_host ~port:conf.factorio_rcon_port
+                ~password:conf.factorio_rcon_password
+  in
+  let homeserver = Uri.of_string conf.matrix_homeserver in
+  let%bind token =
+    matrix_login ~homeserver ~username:conf.matrix_username ~password:conf.matrix_password
+  in
+  (* printf "token is: %s\n" token; *)
+  let reader = matrix_message_stream ~homeserver ~token ~state:None in
+  printf "ready to bridge messages\n";
+  let matrix_to_factorio () = 
+    let%bind _ =
+      Pipe.iter reader ~f:(fun item ->
+        let sender = matrix_get_sender item in
+        if String.(sender = conf.matrix_username) then
+          return ()
+        else
+          let body = matrix_get_body item in
+          let str = sprintf "%s: %s" sender body in
+          Pipe.write writer str) in
+    return ()
+  in
+  let factorio_to_matrix () =
+    let stdin = Lazy.force Reader.stdin in
+    let pipe = Reader.lines stdin in
+    let%bind _ =
+      Pipe.iter pipe ~f:(fun line ->
+        if (String.is_substring ~substring:"[CHAT]" line)
+           && not (String.is_substring ~substring:"[CHAT] <server>" line) then
+          let (_, msg) = String.lsplit2_exn line ~on:']' in
+          matrix_send ~homeserver ~token ~channel:conf.matrix_channel (sprintf "[factorio] %s" msg)
+        else return ()
+    ) in
+    return ()
+  in
+  Deferred.all_unit [matrix_to_factorio (); factorio_to_matrix ()]
+
+let () =
+  Command.async ~summary:"Run the factorio-matrix bridge"
+    Command.Let_syntax.(
+      let%map_open dbpath =
+        flag "-dbpath" (optional_with_default "/tmp/test.db" string)
+          ~doc:"Database path"
+      and config =
+        flag "-config" (optional_with_default "/etc/factorio-bridge/bridge.conf" string)
+          ~doc:"Config path"
+      in
+      fun () -> main ~dbpath ~config)
+  |> Command.run