Start at external networking (socat)

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

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) ->
+    | (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 iobuf sender forum text
+          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
     
 

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
+    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

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 *)

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."

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 ->
+      ()

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 =

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

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

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

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)