Add simplistic logging

It only logs everything it gets, what it is going to do with that
information remains to be seen, it may also change the structure of
the database.
This commit is contained in:
Tom Willemse 2013-04-25 01:31:29 +02:00
parent 7421364315
commit 0cd2ad09ce
3 changed files with 46 additions and 9 deletions

View file

@ -18,4 +18,6 @@
;;; Code: ;;; Code:
(defpackage :org.ryuslash.sil (defpackage :org.ryuslash.sil
(:use :cl :xmpp)) (:use :cl :xmpp :sqlite)
(:shadow :connect :disconnect)
(:export :sil))

View file

@ -28,6 +28,6 @@
:maintainer "Tom Willemsen <tom@ryuslash.org>" :maintainer "Tom Willemsen <tom@ryuslash.org>"
:description "A silly jabber bot." :description "A silly jabber bot."
:serial t :serial t
:depends-on (:cl-xmpp) :depends-on (:cl-xmpp :cl-xmpp-tls :sqlite)
:components ((:file "package") :components ((:file "package")
(:file "sil"))) (:file "sil")))

View file

@ -19,13 +19,16 @@
(in-package :org.ryuslash.sil) (in-package :org.ryuslash.sil)
(require 'cl-xmpp-tls) (defmacro sql (&body body)
(apply 'concatenate 'string
(export '(sil)) (mapcar (lambda (itm) (format nil "~A " itm)) body)))
(defvar *connection* nil (defvar *connection* nil
"The connection to the jabber server.") "The connection to the jabber server.")
(defvar *db* nil
"The database connection.")
(defvar *host* nil (defvar *host* nil
"The host to log-in on.") "The host to log-in on.")
@ -44,9 +47,28 @@
(defvar *jid* nil (defvar *jid* nil
"The JID used.") "The JID used.")
(defun ensure-db-exists (name)
"Connect to the daatabase, possibly creating it."
(let ((db-exists (probe-file name)))
(setf *db* (sqlite:connect name))
(unless db-exists
(execute-non-query
*db* (sql create table "log" ("timestamp" integer\,
"msg_from" varchar (255)\,
"msg_body" text\,
"msg_type" varchar (255)))))))
(defun get-db-location ()
"Get the location of the database."
(let ((xdg (sb-ext:posix-getenv "XDG_DATA_HOME"))
(home (sb-ext:posix-getenv "HOME")))
(pathname
(concatenate 'string (or xdg home) (unless xdg "/.local/share")
"/sil/log.db"))))
(defun get-rc-location () (defun get-rc-location ()
"Get the location of the RC file." "Get the location of the RC file."
(let ((xdg (sb-ext:posix-getenv "XDG_DATA_HOME")) (let ((xdg (sb-ext:posix-getenv "XDG_CONFIG_HOME"))
(home (sb-ext:posix-getenv "HOME"))) (home (sb-ext:posix-getenv "HOME")))
(pathname (pathname
(apply 'concatenate 'string (apply 'concatenate 'string
@ -65,6 +87,10 @@
(t (format nil "auto-reply to: ~A" (from message))))) (t (format nil "auto-reply to: ~A" (from message)))))
(defmethod handle ((connection connection) (message message)) (defmethod handle ((connection connection) (message message))
(execute-non-query
*db* (sql insert into "log" values (?\, ?\, ?\, ?))
(get-universal-time) (from message) (body message) (type- message))
(if (string-equal (type- message) "groupchat") (if (string-equal (type- message) "groupchat")
(when (string-equal (body message) "," :end1 1) (when (string-equal (body message) "," :end1 1)
(setf (body message) (subseq (body message) 1)) (setf (body message) (subseq (body message) 1))
@ -72,20 +98,28 @@
(get-response message) :type :groupchat)) (get-response message) :type :groupchat))
(xmpp:message connection (from message) (get-response message)))) (xmpp:message connection (from message) (get-response message))))
(defun load-db ()
"Load the database."
(let ((db-location (get-db-location)))
(ensure-directories-exist db-location)
(ensure-db-exists db-location)))
(defun load-rc () (defun load-rc ()
"Load the RC file." "Load the RC file."
(let ((*package* (in-package :org.ryuslash.sil))) (let ((*package* (in-package :org.ryuslash.sil)))
(load (get-rc-location) :if-does-not-exist nil))) (load (get-rc-location) :if-does-not-exist nil)))
(defun receive () (defun receive ()
(format t "Recieving~%")
(handler-case (receive-stanza-loop *connection*) (handler-case (receive-stanza-loop *connection*)
(simple-error () (receive)))) (simple-error (err)
(format t "Error: ~A~%" err)
(receive))))
(defun sil (args) (defun sil (args)
(handler-case (handler-case
(progn (progn
(load-rc) (load-rc)
(load-db)
(setf *connection* (connect-tls :hostname *host*)) (setf *connection* (connect-tls :hostname *host*))
(auth *connection* *username* *password* *resource*) (auth *connection* *username* *password* *resource*)
(map nil (lambda (ms) (map nil (lambda (ms)
@ -94,4 +128,5 @@
(receive)) (receive))
(sb-sys:interactive-interrupt () (sb-sys:interactive-interrupt ()
(format t "No! Don't leave me. *sob*~%"))) (format t "No! Don't leave me. *sob*~%")))
(disconnect *connection*)) (sqlite:disconnect *db*)
(xmpp:disconnect *connection*))