first working version of zebot (web interface with hunchentoot is on the way)

gistfile1.lisp

(in-package :cl-user)

(ql:quickload '("usocket" "cl-who"))

(defpackage zebot
  (:use :cl :usocket :cl-who))

(in-package zebot)

(defvar *NICK* "botnick")
(defvar *PASSWORD* "lololol")

(defstruct message msg sender)

(defvar *channels* (make-hash-table :test #'equal))
(defun auto-join-channel (channel-name)
  (setf (gethash channel-name *channels*) '()))

(auto-join-channel "#lisp")
(auto-join-channel "#python")

(defmacro concat (&rest sequences)
  `(concatenate 'string ,@sequences))

(defun update-html ()
  (loop for channel-or-nick being the hash-keys of *channels* do
    (let ((msgs (reverse (gethash channel-or-nick *channels*))))
      (princ msgs)
      (with-open-file (file-stream (concat "/home/sinan/Desktop/cl/logs/"
                                           (if (equal #\# (elt channel-or-nick 0))
                                               (subseq channel-or-nick 1)
                                               "direct-messages")
                                           ".html") ;; remove # from channel name
                                   :direction :output
                                   :if-exists :append
                                   :if-does-not-exist :create)
        (with-html-output (file-stream)
          (dolist (msg msgs)
            (let ((message-text (concat (message-sender msg)
                                        "> "
                                        (message-msg msg))))
              (htm (:p :class "msg" (str message-text)))))))
      (setf (gethash channel-or-nick *channels*) '()))))

(defgeneric handle-command (prefix command params socket-stream))

(defmethod handle-command (prefix (command (eql 'privmsg)) params socket-stream)
  (let ((channel-or-nick (subseq params 0 (position #\space params)))
        (sender (subseq prefix 0 (position #\! prefix)))
        (msg (subseq params (+ 2 (position #\space params)))))
    (format t "~A -> ~A: ~A~%" sender channel-or-nick msg)
    (multiple-value-bind (channel-message-queue channel-exists)
        (gethash channel-or-nick *channels*)
      (unless channel-exists
        (setf (gethash channel-or-nick *channels*) '()))
      (setf (gethash channel-or-nick *channels*)
            (cons (make-message :msg msg
                                :sender sender) channel-message-queue)))))

(defmethod handle-command (prefix (command (eql 'ping)) params socket-stream)
  (format socket-stream "PONG ~A~%" *NICK*) ;; TODO: hostname?
  (finish-output socket-stream))

(defmethod handle-command (prefix (command (eql 'notice)) params socket-stream)
  (cond ((search "Ident" params)
         (format socket-stream "NICK ~A~%" *NICK*)
         (format socket-stream "USER ~A 0 * :zebot asdf~%" *NICK*)
         (format t "NICK ~A~%" *NICK*)
         (format t "USER ~A 0 * :zebot asdf~%" *NICK*)
         (finish-output socket-stream)
        ((search "identify" params)
         (format socket-stream "PRIVMSG nickserv :identify ~A~%" *PASSWORD*)
         (finish-output socket-stream)
         (sleep 5)
         (loop for key being the hash-keys of *channels* do
           ;; WTF
           (progn (format socket-stream "JOIN ~A~%" key)
                  (finish-output socket-stream)
                  (format t "JOIN ~A~%" key)
                  (finish-output))))))

(defmethod handle-command (prefix command params socket-stream))

(defun parse-msg (msg)
  "Parse irc message to prefix, command and params.
http://www.irchelp.org/irchelp/rfc/chapter2.html#c2_3_1
<message> ::=
    [':' <prefix> <SPACE> ] <command> <params> <crlf>
<prefix> ::=
    <servername> | <nick> [ '!' <user> ] [ '@' <host> ]
<command> ::=
    <letter> { <letter> } | <number> <number> <number>
<params> ::=
    <SPACE> [ ':' <trailing> | <middle> <params> ]
"
  (let* ((first-space (position #\space msg))
         (first (subseq msg 0 first-space))
         (rest (subseq msg (1+ first-space)))
         (prefix (if (eq (elt first 0) #\:)
                     (subseq first 1)
                     nil))
         (second-space (position #\space rest)))
    (if prefix
        (let ((command (subseq rest 0 second-space))
              (params (subseq rest (1+ second-space))))
          (values prefix command params))
        (let ((command (subseq first 0 first-space))
              (params rest))
          (values nil command params)))))

(defun run ()
  (let* ((socket (socket-connect "irc.freenode.org" 8001))
         (socket-stream (socket-stream socket))
         (start-time (get-universal-time)))
    (loop
      (let ((msg (read-line socket-stream)))
        (format t "~A~%" msg)
        (multiple-value-bind (prefix command params) (parse-msg msg)
          (handle-command prefix (intern (string-upcase command)) params socket-stream)))
      (let ((time-passed (- (get-universal-time) start-time)))
        (when (> time-passed (* 1 30))
          (update-html)
          (setf start-time (get-universal-time)))))))