From 1a06efd5fc6dbb0ecf544a38886729e33b2ba5ff Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Fri, 10 Dec 2010 17:03:24 -0700 Subject: [PATCH] Start at external networking (socat) --- Makefile | 4 +- bot.ml | 108 +++++++++++++++++++++++++++++++++++---------------- dispatch.ml | 13 +++++-- dispatch.mli | 5 +-- helper | 16 ++++++-- infobot.ml | 8 ++++ iobuf.ml | 4 +- iobuf.mli | 1 + irc.ml | 12 +++++- irc.mli | 1 + process.ml | 103 +++++++++++++++++++++++++++++++++++++++++++----- 11 files changed, 218 insertions(+), 57 deletions(-) diff --git a/Makefile b/Makefile index 00d33ee..07e167f 100644 --- a/Makefile +++ b/Makefile @@ -1,11 +1,11 @@ INCLUDES = OCAMLFLAGS = $(INCLUDES) OCAMLOPT = ocamlopt -OCAMLC = ocamlc +OCAMLC = ocamlc -g OCAMLDEP = ocamldep $(INCLUDES) OCAMLLIBS = unix.cma str.cma nums.cma -bot: irc.cmo dispatch.cmo command.cmo iobuf.cmo cdb.cmo bindings.cmo infobot.cmo bot.cmo infobot.cmo +bot: irc.cmo dispatch.cmo process.cmo command.cmo iobuf.cmo cdb.cmo bindings.cmo infobot.cmo bot.cmo infobot.cmo $(OCAMLC) -o $@ $(OCAMLLIBS) $^ .PHONY: clean diff --git a/bot.ml b/bot.ml index 314cae6..b1453b8 100644 --- a/bot.ml +++ b/bot.ml @@ -2,63 +2,103 @@ type bot = { store: Infobot.t; } +let debug = prerr_endline + +let file_descr_of_int (i:int) = + let blob = Marshal.to_string i [] in + (Marshal.from_string blob 0 : Unix.file_descr) + let write iobuf command args text = let cmd = Command.create None command args text in - print_endline ("--> " ^ (Command.as_string cmd)); + debug ("--> " ^ (Command.as_string cmd)); Iobuf.write iobuf cmd let msg iobuf recip text = write iobuf "PRIVMSG" [recip] (Some text) -let calc_re = Str.regexp "^calc \\(.*\\)" -let calc iobuf forum text = - if Str.string_match calc_re text 0 then - msg iobuf forum (Str.matched_group 1 text) +let split = Str.split (Str.regexp "[ \t]*\r?\n") + +(** Callback upon completion of the external command helper *) +let extern_callback iobuf sender forum text = + let lines = split text in + let nlines = List.length lines in + let recip = + if (nlines > 5) then begin + if (forum <> sender) then + msg iobuf forum (Format.sprintf "%d lines, sending privately" nlines); + sender + end else + forum + in + let rec f = function + | [] -> + () + | "" :: tl -> + f tl + | line :: tl -> + if line.[0] == ':' then + (* Interpret as raw IRC commands *) + let ine = Str.string_after line 1 in + let cmd = Command.from_string ine in + Iobuf.write iobuf cmd + else + (* Naive case: send to the recipient *) + msg iobuf recip line; + f tl + in + f lines let handle_privmsg bot iobuf sender forum text = - calc iobuf forum text; - match (Infobot.lookup bot.store text) with - | Some reply -> - msg iobuf forum reply - | None -> - () - + if text.[0] == '.' then + Process.create_canned + (Iobuf.dispatcher iobuf) + text + (extern_callback iobuf sender forum) + "./helper" + [|"./helper"; sender; forum|] + else + Infobot.handle_privmsg bot.store (msg iobuf forum) sender forum text -let handle_command bot iobuf cmd = - print_endline ("<-- " ^ (Command.as_string cmd)); +let handle_command bot outbuf thisbuf cmd = + debug ("<-- " ^ (Command.as_string cmd)); match (Command.as_tuple cmd) with - | (Some sender, "PRIVMSG", [target], Some text) -> - let forum = - if Irc.is_channel target then - target - else - sender - in - handle_privmsg bot iobuf sender forum text + | (Some suhost, "PRIVMSG", [target], Some text) -> + let sender = Irc.nick (Irc.nuhost_of_string suhost) in + let forum = + if Irc.is_channel target then + target + else + sender + in + handle_privmsg bot outbuf sender forum text | (_, "PING", _, text) -> - write iobuf "PONG" [] text + write outbuf "PONG" [] text | (_, "001", _, _) -> - write iobuf "JOIN" ["#bot"] None + write outbuf "JOIN" ["#bot"] None; | (Some sender, "JOIN", [], Some chan) -> - msg iobuf chan "hi asl" + msg outbuf chan "hi asl" | _ -> () +let discard_command iobuf cmd = () + let handle_error iobuf str = - print_endline str + prerr_endline ("!!! " ^ str) let main () = - let host = Unix.gethostbyname "woozle.org" in - let dispatcher = Dispatch.create () in - let conn = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in let bot = {store = Infobot.create "info.cdb"} in - let _ = Unix.connect conn (Unix.ADDR_INET (host.Unix.h_addr_list.(0), 6667)) in - let iobuf = Iobuf.create dispatcher conn "woozle" - (handle_command bot) + let dispatcher = Dispatch.create () in + + let iobuf_out = Iobuf.create dispatcher Unix.stdout "collab_out" + discard_command handle_error in - write iobuf "NICK" ["bot"] None; - write iobuf "USER" ["bot"; "bot"; "bot"] (Some "A Bot"); + let _ = Iobuf.create dispatcher Unix.stdin "collab_in" + (handle_command bot iobuf_out) + handle_error + in + write iobuf_out "NICK" ["zinc"] None; + write iobuf_out "USER" ["zinc"; "zinc"; "zinc"] (Some "I'm a little printf, short and stdout"); Dispatch.run dispatcher diff --git a/dispatch.ml b/dispatch.ml index 5a320a0..975b71f 100644 --- a/dispatch.ml +++ b/dispatch.ml @@ -22,7 +22,7 @@ type t = { timers : Timer.t ref; } -let create ?(size=5) () = +let create () = {read_fds = ref []; write_fds = ref []; except_fds = ref []; @@ -119,9 +119,14 @@ let once d = let s = { Unix.it_interval = interval; Unix.it_value = 0.0 } in let _ = Sys.set_signal Sys.sigalrm Sys.Signal_ignore in let _ = Unix.setitimer Unix.ITIMER_REAL s in - let result = Unix.select !(d.read_fds) !(d.write_fds) !(d.except_fds) (-1.0) in - dispatch_results d result; - dispatch_timers d (Unix.gettimeofday ()) + try + let result = + Unix.select !(d.read_fds) !(d.write_fds) !(d.except_fds) (-1.0) + in + dispatch_results d result; + dispatch_timers d (Unix.gettimeofday ()) + with Unix.Unix_error (Unix.EINTR, _, _) -> + () let rec run d = if (Fd_map.is_empty !(d.handlers)) && (Timer.is_empty !(d.timers)) then diff --git a/dispatch.mli b/dispatch.mli index cf89122..6e07529 100644 --- a/dispatch.mli +++ b/dispatch.mli @@ -10,9 +10,8 @@ type fd_handler = Unix.file_descr -> event -> unit type timer_handler = float -> unit (** [timer_handler d when] is called at or after [when] *) -val create : ?size:int -> unit -> t -(** Create a new event dispatcher, preallocating [size] fd events. - [size] is just a hint, the fd list will grow on demand. *) +val create : unit -> t +(** Create a new event dispatcher. *) val destroy : t -> unit (** Destroy an event dispatcher *) diff --git a/helper b/helper index 747c3fe..af60518 100755 --- a/helper +++ b/helper @@ -8,8 +8,13 @@ case $cmd in .hi) echo "Hi, ASL" ;; - .date) - date + .time) + if [ -n "$args" ]; then + a=$(echo $args | awk '{print "-d " $1}') + fi + echo $(date $a +%s) --- \ + $(date $a --rfc-3339=seconds) --- \ + $(date $a --utc --rfc-3339=seconds) ;; .msgme) echo ":PRIVMSG $sender :hey baby" @@ -20,7 +25,12 @@ case $cmd in echo $args | cut -d@ -f 1 | nc $host finger ;; .calc) - echo $args | bc -l + echo $args | (echo -n "$args = "; bc -l) + ;; + .units) + a=$(echo $args | sed 's/->.*//') + b=$(echo $args | sed 's/.*->//') + units -v "$a" "$b" ;; *) echo "I'm sorry, $sender, I don't understand that command." diff --git a/infobot.ml b/infobot.ml index 2dd9888..2ee031e 100644 --- a/infobot.ml +++ b/infobot.ml @@ -60,3 +60,11 @@ let lookup store text = Some (Printf.sprintf "I overheard that %s is %s" text factoid) with Not_found -> None + + +let handle_privmsg store msg sender forum text = + match (lookup store text) with + | Some reply -> + msg reply + | None -> + () diff --git a/iobuf.ml b/iobuf.ml index b263071..260daa7 100644 --- a/iobuf.ml +++ b/iobuf.ml @@ -16,11 +16,13 @@ and error_handler = t -> string -> unit let ibuf_max = 4096 -let max_outq = 50 +let max_outq = 2000 let obuf_max = 4096 let name iobuf = iobuf.name +let dispatcher iobuf = iobuf.d + let crlf = Str.regexp "\r?\n" let handle_input iobuf = diff --git a/iobuf.mli b/iobuf.mli index a6885f4..3c0e225 100644 --- a/iobuf.mli +++ b/iobuf.mli @@ -7,5 +7,6 @@ val create : Dispatch.t -> Unix.file_descr -> string -> command_handler -> error val close: t -> string -> unit val name : t -> string +val dispatcher : t -> Dispatch.t val write : t -> Command.t -> unit val bind : t -> command_handler -> error_handler -> unit diff --git a/irc.ml b/irc.ml index 95fc4a3..90a850d 100644 --- a/irc.ml +++ b/irc.ml @@ -49,7 +49,17 @@ let truncate s len = else Str.string_before s (min slen len) -let string_of_nuhost (nick, user, host) = nick ^ "!" ^ user ^ "@" ^ host +let nuhost_re = Str.regexp "\\(.*\\)!\\(.*\\)@\\(.*\\)" +let nuhost_of_string str = + if Str.string_match nuhost_re str 0 then + (Str.matched_group 1 str, + Str.matched_group 2 str, + Str.matched_group 3 str) + else + raise Not_found + +let string_of_nuhost (nick, user, host) = + nick ^ "!" ^ user ^ "@" ^ host let nick (nick, user, host) = nick let user (nick, user, host) = user let host (nick, user, host) = host diff --git a/irc.mli b/irc.mli index 489e442..fadde39 100644 --- a/irc.mli +++ b/irc.mli @@ -10,6 +10,7 @@ val uppercase : string -> string val lowercase : string -> string val truncate : string -> int -> string +val nuhost_of_string : string -> nuhost val string_of_nuhost : nuhost -> string val nick : nuhost -> string val user : nuhost -> string diff --git a/process.ml b/process.ml index 3c6c4e0..2894d63 100644 --- a/process.ml +++ b/process.ml @@ -1,15 +1,100 @@ -type t = { - -} - -let create iobuf prog args = +let spawn prog args = let fd0_exit, fd0_entr = Unix.pipe () in let fd1_exit, fd1_entr = Unix.pipe () in - let fd2_exit, fd2_entr = Unix.pipe () in - let pid = Unix.create_process prog args fd0_exit fd1_entr fd2_entr in + match (Unix.fork ()) with + | 0 -> (* Child *) + Unix.dup2 fd0_exit Unix.stdin; + Unix.close fd0_entr; + Unix.close fd0_exit; + + Unix.dup2 fd1_entr Unix.stdout; + Unix.dup2 fd1_entr Unix.stderr; + Unix.close fd1_entr; + Unix.close fd1_exit; + + Unix.execvp prog args + + | pid -> (* Parent *) + Unix.close fd0_exit; + Unix.close fd1_entr; + + (fd0_entr, fd1_exit) -let handle_event process fd event = +let create d text input_handler output_handler prog args = + let child_stdin, child_stdout = spawn prog args in + Dispatch.add d child_stdin output_handler [Dispatch.Output]; + Dispatch.add d child_stdout input_handler [Dispatch.Input] + + +(** Canned process: sends a string on stdin, collects stdout and stderr, + and calls a callback when everything's finished. *) + +type canned = { + finished : string -> unit; + stdin : string; + stdout : string; + stderr : string; + mutable stdin_pos : int; + mutable stdout_pos : int; + mutable stderr_pos : int; +} + +let canned_handler d p fd event = match event with | Dispatch.Input -> - + let len = + Unix.read fd p.stdout p.stdout_pos + ((String.length p.stdout) - p.stdout_pos) + in + if (len > 0) then + p.stdout_pos <- p.stdout_pos + len + else begin + Dispatch.delete d fd; + p.finished (String.sub p.stdout 0 p.stdout_pos) + end + | Dispatch.Output -> + let len = + Unix.write fd p.stdin p.stdin_pos + ((String.length p.stdin) - p.stdin_pos) + in + p.stdin_pos <- p.stdin_pos + len; + if (p.stdin_pos == String.length p.stdin) then begin + Unix.close fd; + Dispatch.delete d fd + end + | Dispatch.Exception -> + () + +let create_canned d text finished prog args = + let p = + { + finished=finished; + stdin=text; stdin_pos=0; + stdout=String.create 8192; stdout_pos=0; + stderr=String.create 8192; stderr_pos=0; + } + in + let handler = (canned_handler d p) + in + create d text handler handler prog args + + + + + + +(** Zombie reapin' mayhem *) +let rec sigchld s = + try + match Unix.waitpid [Unix.WNOHANG] (-1) with + | (0, _) -> + () + | _ -> + sigchld s + with Unix.Unix_error (Unix.ECHILD, _, _) -> + () + +let _ = + Sys.set_signal Sys.sigchld (Sys.Signal_handle sigchld) +