Urkle - An awkward IRCd

urkle.clj

(use '(clojure.contrib str-utils seq-utils duck-streams server-socket))
(use '(clojure.contrib stacktrace))



(declare *name*)

(def *users* (ref {}))

(def *channels* (ref {}))

;Replies and Errors. See e.g. http://www.mirc-support.de/reference/raw.nameidx.htm"
(def replies 
  {:rpl_welcome 1
   :rpl_yourhost 2
   :rpl_created 3
   :rpl_myinfo 4
   :rpl_protocol 5
   :rpl_liststart 321
   :rpl_list 322
   :rpl_listend 323
   :err_unkowncommand 421
   })

(def server-name "supergeheim.example.com")

(defn nick [name & args]
  "Set/change nick name"
  (dosync (commute *users* conj {(keyword name) *out*}))
  name)

(defn join [channel]
  "Join a channel or create it"
  (dosync 
    (if (contains? @*channels* (keyword channel))
      (commute *channels* update-in [(keyword channel)] conj (keyword *name*)) 
      (commute *channels* conj {(keyword channel) [(keyword *name*)]}))))

(defn ping [arg & _]
  (str-join " " [(str ":" server-name) "PONG" arg (str ":" *name*)]))

(defn reply
  "Send a reply like:
  001 bracki :Your welcome!"
  ([reply msg]
          (str-join " " [(str ":" server-name) (format "%03d" (reply replies)) (str ":" msg)]))
  ([reply recipient msg]
          (str-join " " [(str ":" server-name) (format "%03d" (reply replies)) recipient (str ":" msg)])))

(defn privmsg [recipient & msg]
  (if (.startsWith recipient "#")
    (doseq [user ((keyword recipient) @*channels*)]
      (binding [*out* (user @*users*)]
        (println 
          (str-join " " [(str ":" *name*) "PRIVMSG" recipient (str-join " " msg)]))))
  (binding [*out* ((keyword recipient) @*users*)]
    (println 
      (str-join " " [(str ":" *name*) "PRIVMSG" recipient (str-join " " msg)])))))

(defn user[_ & _]
  (println
    (reply :rpl_welcome  *name* "This is Urkle IRC. The awkward ircd written in Clojure."))
  (println
    (reply :rpl_yourhost  *name* "Your host is supergeheim.com running super alpha stuff.")))

(defn list_[]
  "LIST all known channels."
  (println (reply :rpl_liststart  (str *name* " " "Channel") "Users Topic"))
  (when (not (empty? @*channels*))
    (doseq [channel @*channels*]
      (println (reply :rpl_list (str *name* " " (name (key channel)) " " (count (val channel))) ""))))  
  (println (reply :rpl_listend *name* "End of /LIST")))

(def commands {"NICK" nick,
               "USER" user,
               "JOIN" join,
               "LIST" list_,
               "PING" ping,
               "PRIVMSG" privmsg,
               })

(defn execute
  "Execute commands"
  [input]
  (let [[command & args] (re-split #"\s+" input)]
    (try
      (apply (commands command) args)
      (catch NullPointerException _ 
        (println (reply :err_unkowncommand command "Unknown Command."))))))

(defn- urkle-handle-client [in out]
  (binding [*in* (reader in)
            *out* (writer out)]
    (binding [*name* (execute (read-line))]
      (loop [input (read-line)]
        (when input
          (execute input)
          (recur (read-line)))))))

(defonce server (create-server 3333 urkle-handle-client))