Skip to content

Instantly share code, notes, and snippets.

@osa1
Created January 5, 2012 19:46
Show Gist options
  • Save osa1/1566862 to your computer and use it in GitHub Desktop.
Save osa1/1566862 to your computer and use it in GitHub Desktop.
first working version of zebot (web interface with hunchentoot is on the way)
(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)))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment