gistfile1.ml

(**************************************************************************
 * File           : mir.sml
 * Project        : ML IRC Robot
 * Author         : Christian Axelsson
 * Created        : 2006-01-23
 * Description    : An IRC robot written in SML (with Moscow ML extensions)
 **************************************************************************)
val _ = app load ["Socket", "Byte", "Date"];
(* event
   This represent all events that can be triggerd. Note than some events may
   come from IRC and some come from ML functions.
*)
exception Error of string
datatype event = EVENT_PING    (* PING from server recived *)
	       | EVENT_MSG     (* Message recived, may be a channel or a private message, the argument will tell *)
	       | EVENT_NOTICE  (* Notice recived *)
	       | EVENT_CONNECT (* Connected *)
	       | EVENT_JOIN    (* Joined a channel *)
	       | EVENT_PART    (* Left a channel *)
	       | EVENT_KICK    (* A user kicked from channel *)
	       | EVENT_UNKNOWN (* Any other event *)


type user = { nick : string, user : string, host : string };

type sping = { server : string };
type chanmsg = { channel : string, nick : user, message : string };
type privmsg = { nick : user, message : string };
type channotice = { channel : string, nick : user, message : string };
type privnotice = { nick : user, message : string };
type join = { channel : string, nick : user };

datatype ircmessage = SPING of sping           (* Server ping *)
		    | CHANMSG of chanmsg       (* Channel message *)
		    | PRIVMSG of privmsg       (* Private message *)
		    | PRIVNOTICE of privnotice (* Private notice *)
		    | CHANNOTICE of channotice (* Channel notice *)
		    | JOIN of join             (* Join in a channel *)
		    | UNKNOWN of string        (* Unhandled event *)
		    | UNIT                     (* Used for stuff that dont need args *)

val registerdEvents = ref [];

(*local*)
    (* Configuration 
       ============= *)

    (* Server that the bot shall connect to *)
    val server = "195.54.159.109"; (* Prolly need to write our own 
                                      resolver if we want DNS *shrug* *)

    (* What port to use *)
    val port = 6666;

    (* What password to send to the server.
       SOME("foobar") - Use this if your password is "foobar".
       NONE           - Use this if you dont have a password.
    *)
    val password = NONE

    (* User in case no identd running *)
    val botuser = "mjuk"

    (* Bot nickname *)
    val botnick = "smlko"

    (* Bot nickname if botnick is taken *)
    val altnick = "smlko_"

    (* Value to set as realname for the bot *)
    val botname = "Den mjuka kossan"

    (* List of channels for the bot to join *)
    val channels = ["#dvp05", "#dvp"];

    (* File to log traffic to, make sure this exists and is writable! *)
    val logfile = "irc.log"

    (* ====================
       End of configuration *)

    val sock = Socket.inetStream(); (* The socket *)
	
    (* This type represents an argument from any IRC command.
       argument is SOME(argumend) if there where any argument to the command.
       prefix is SOME(prefix) if there where any prefix to the command.
    *)
    type arg = {argument : string option, prefix : string option }
(*in*)
    
(* putlog s
   TYPE		: string -> unit
   PRE		: The file specfied by logfile exists and is writable.
   POST		: (none)
   SIDE-EFFECTS : s written to the logfile specfied by logfile.
*)
fun putlog s = 
    let
	val os = TextIO.openAppend logfile
	val str = Date.toString(Date.fromTimeLocal((Time.now()))) ^ 
		  ": " ^ s ^ "\n"
    in
	TextIO.print str;
	TextIO.output(os, str);
	TextIO.flushOut os;
	TextIO.closeOut os
    end

(* putrawlog s
   TYPE		: string -> unit
   PRE		: The file specfied by rawlogfile exists and is writable.
   POST		:
   SIDE-EFFECTS :
*)
fun putrawlog s = 
    let
	val os = TextIO.openAppend "raw.log"
	val str = Date.toString(Date.fromTimeLocal((Time.now()))) ^ 
		  ": " ^ s
    in
	TextIO.output(os, str ^ "\n");
	TextIO.flushOut os;
	TextIO.closeOut os
    end

(* shutdown ()
   TYPE		: unit -> unit
   PRE		: (none)
   POST		: (none)
   SIDE-EFFECTS : Closes sock and ends the program
*)
fun shutdown () = 
    (putlog "[I]: Shutting down bot...";
     Socket.shutdown(sock, Socket.NO_RECVS_OR_SENDS);
     Socket.close sock);

(* putserv s
   TYPE		: string -> unit
   PRE		: sock is an open socket.
   POST		: (none)
   SIDE-EFFECTS : Sends s to sock.
*)
fun putserv s = 
    let
	val str = s ^ "\n"
    in
	putrawlog s;
	Socket.sendVec(sock, { buf = Byte.stringToBytes str,
			       ofs = 0,
			       size = NONE });
	() (* Returning unit saves alot of trouble and we are usually not
              intressed in the returnvalue of sendVec anyways *)
    end


(* putchan (c, m)
   TYPE         : string * string -> unit
   PRE          : 
   POST         :
   EXAMPLES     :
*)



(* registerEvent (e, f)
   TYPE         : event -> unit
   PRE          : (none)
   POST         : (none)
   SIDE-EFFECTS : Adds f to the list of functions for the event e.
*)
(* VARIANT      : Number of elements in !registerdEvents *)
fun registerEvent (e, f) = 
    let
	fun doReg [] =
	    if List.length(!registerdEvents) = 0 then
		registerdEvents := (e, f :: []) :: []
	    else
		registerdEvents := (e, f :: []) :: !registerdEvents
	  | doReg ((event, functions) :: tail) = 
	    if e = event then
		registerdEvents := (e, f :: functions) :: tail
	    else 
		doReg tail
    in
	doReg(!registerdEvents)
    end

(* EVENTS *)
fun default_ping (SPING({server = s})) = putserv("PONG :" ^ s)

fun default_connect (_) =
    let
	fun joinChannels [] = ()
	  | joinChannels (c :: tail) = 
	    (putlog("[I]: Joining " ^ c);
	     putserv("JOIN " ^ c);
	     joinChannels tail)
    in
	joinChannels(channels)
    end

fun default_join (JOIN({channel = chan,
			nick = { nick = nick,
				 user = user,
				 host = host }})) =
    putchan(chan, "Halloj " ^ nick ^ "!");

(* END EVENTS *)

(* runEvents(e, arg)
   TYPE         : event * arg -> unit
   PRE          : (none)
   POST         : (none)
   SIDE-EFFECTS : Any functions associatet with the event e is run with
                  argument arg.
*)
fun runEvents(e, arg) =
    let
	fun getFunList [] = []
	  | getFunList ((event, functions) :: tail) = 
	    if e = event then
		functions
	    else
		getFunList tail

	fun runFunctions [] = ()
	  | runFunctions (f :: rest) = f(arg)
    in
	runFunctions(getFunList(!registerdEvents))
    end

local
    (* recv ()
       TYPE		: unit -> string
       PRE		: sock is an open socket
       POST		: The data from sock until next "\n".
    *)
    fun recv () =
	let
	    (* recvAux ()
               TYPE         : unit -> string
               PRE          : sock is an open socket
               POST         : The data from sock until next "\n".
               SIDE-EFFECTS : Data is read from sock to and including next "\n"
            *)
	    fun recvAux () = 
		let
		    val s = Byte.bytesToString(Socket.recvVec(sock, 1))
		in
		    if size s = 0 orelse s = "\n" then
			""
		    else
			s ^ recvAux()
		end

	    val s = recvAux()
	in
	    putrawlog s; s
	end

    (* connect ()
       TYPE		: unit -> unit
       PRE		: 
       POST		: 
       SIDE-EFFECTS :
    *)
    fun connect () =
	let
	    (* tryNick (n, anick)
               TYPE         : string * bool -> bool
               PRE          : (none)
               POST         : true if nick registration was ok, else false
            *)
            (* VARIANT      : 2 *)
	    fun tryNick (n, anick) = 
		(putserv("NICK " ^ n);
		 let
		     val s = recv()
		 in
		     if List.length(String.tokens (fn c => c = #" ") s) = 2
		     then
			 (* Nick OK return the number that we should PONG to *)
			 SOME("PONG " ^ List.nth((String.tokens 
						      (fn c => c = #":")
						      s), 1))
		     else 
			 (* Nick already in use or illegal chars. Try altnick 
                            if we already havent or return failure *)
			 if anick then
			     NONE
			 else
			     tryNick(altnick, true)
		 end)
	    
	    (* register ()
               TYPE         : unit -> unit
               PRE          : 
               POST         :
            *)
	    fun register () = 
		let
		    val status = tryNick(botnick, false)
		in
		    if Option.isSome status then
			(putserv("USER " ^ botuser ^ " 8 * :" ^ botname);
			 putserv("PONG " ^ valOf status))
		    else
			(putlog "[E]: Couldn't use any configured nick.";
			 shutdown())
		end
	in
	    putlog("[I]: Connecting to " ^ server ^ ":" ^ Int.toString port);
	    Socket.connect(sock, (Socket.inetAddr server port));
	    (* Recive the 3 AUTH lines (this is kinda ugly ;D) *)
	    recv(); recv(); recv();
	    if Option.isSome password then
		(putserv("PASS " ^ valOf password); register())
	    else
		(register(); runEvents(EVENT_CONNECT, UNIT))
	end
in

(* mainLoop ()
   TYPE         : unit -> unit
   PRE          : 
   POST         :
*)
fun mainLoop () =
    let
	(* listToString l
           TYPE         : string list -> string
           PRE          : (none)
           POST         : Each element from left to right in l concated with 
                          a space between them (only!).
        *)
	fun listToString [] = ""
	  | listToString (head::[]) = head
	  | listToString (head::tail) = head ^ " " ^ listToString tail

	(* eventFromString s
           TYPE         : string -> (event * ircmessage)
           PRE          : (none)
           POST         : The event corresponding to s
        *)
	(* args = ":server" where server is the server pinging *)
	fun eventFromString s =
	    let
		(* getCommand ()
                   TYPE         : unit -> string
                   PRE          : s is a raw irc message
                   POST         : The command s describes
                *)
		fun getCommand () = 
		    let
			val stringlist = String.fields (fn c => c = #" ") s
		    in
			if String.sub(s, 0) = #":" then
			    List.nth(stringlist, 1)
			else
			    List.nth(stringlist, 0)
		    end
	    in
		case getCommand() of
		    "PING" => (* s = "PING :server.irc.net" *)
		    let
			val server = List.nth((String.tokens 
						   (fn c => c = #":") s), 1)
		    in
			(EVENT_PING, SPING({ server = server }))
		    end

		  | "JOIN" => (* s = ":nick!ident@host JOIN #channel" *)
		    let
			val s = String.fields (fn c => c = #" ") s
			val smask = List.nth(s, 0)
			val chan = List.nth(s, 2)
			val mask = String.substring(smask, 1, size smask - 1)
			val (nick::rest) = String.fields (fn c => c = #"!") mask
			val (user::rest) = String.fields (fn c => c = #"@") (List.nth(rest, 0))
			val host = hd rest
		    in
			(EVENT_JOIN, JOIN({ channel = chan, 
					    nick = { nick = nick,
						     user = user,
						     host = host }
			}))
		    end
		  | _ => (EVENT_UNKNOWN, UNKNOWN(s))
	    end

	fun loop() = 
	    let
		val s = recv()
		val (e, m) = eventFromString s
		val head::tail = String.tokens (fn c => c = #" ") s
	    in
		runEvents(e, m);
		loop()
	    end
    in
	putlog "[I]: Entering mainLoop...";
	loop()
    end

(* main ()
   TYPE		: unit -> unit
   PRE		: (none)
   POST		: (none)
   SIDE-EFFECTS : 
*)
fun main () = 
    let
	val s = "" (* XXX, whatever ;) *)
    in
	(* Setup event handlers *)
	registerEvent(EVENT_PING, default_ping);
	registerEvent(EVENT_CONNECT, default_connect);

	(* Connect and enter main loop *)
	connect();
	mainLoop();
	shutdown()

    end
end

val _ = main();