summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGravatar Tom Willemse2013-04-25 01:31:29 +0200
committerGravatar Tom Willemse2013-04-25 01:31:29 +0200
commit0cd2ad09ce587f15ead955d57baf7d7efbf1912d (patch)
treed348dfecf33fc5b07a2d3dab0988bce1996ab3be
parent7421364315291475eb581675576512f2584af496 (diff)
downloadsil-master.tar.gz
sil-master.zip
Add simplistic loggingHEADmaster
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.
-rw-r--r--lisp/package.lisp4
-rw-r--r--lisp/sil.asd2
-rw-r--r--lisp/sil.lisp49
3 files changed, 46 insertions, 9 deletions
diff --git a/lisp/package.lisp b/lisp/package.lisp
index 7b9c136..881d1f9 100644
--- a/lisp/package.lisp
+++ b/lisp/package.lisp
@@ -18,4 +18,6 @@
;;; Code:
(defpackage :org.ryuslash.sil
- (:use :cl :xmpp))
+ (:use :cl :xmpp :sqlite)
+ (:shadow :connect :disconnect)
+ (:export :sil))
diff --git a/lisp/sil.asd b/lisp/sil.asd
index 1275b4d..6bd97e9 100644
--- a/lisp/sil.asd
+++ b/lisp/sil.asd
@@ -28,6 +28,6 @@
:maintainer "Tom Willemsen <tom@ryuslash.org>"
:description "A silly jabber bot."
:serial t
- :depends-on (:cl-xmpp)
+ :depends-on (:cl-xmpp :cl-xmpp-tls :sqlite)
:components ((:file "package")
(:file "sil")))
diff --git a/lisp/sil.lisp b/lisp/sil.lisp
index 8348a89..6c6abec 100644
--- a/lisp/sil.lisp
+++ b/lisp/sil.lisp
@@ -19,13 +19,16 @@
(in-package :org.ryuslash.sil)
-(require 'cl-xmpp-tls)
-
-(export '(sil))
+(defmacro sql (&body body)
+ (apply 'concatenate 'string
+ (mapcar (lambda (itm) (format nil "~A " itm)) body)))
(defvar *connection* nil
"The connection to the jabber server.")
+(defvar *db* nil
+ "The database connection.")
+
(defvar *host* nil
"The host to log-in on.")
@@ -44,9 +47,28 @@
(defvar *jid* nil
"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 ()
"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")))
(pathname
(apply 'concatenate 'string
@@ -65,6 +87,10 @@
(t (format nil "auto-reply to: ~A" (from 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")
(when (string-equal (body message) "," :end1 1)
(setf (body message) (subseq (body message) 1))
@@ -72,20 +98,28 @@
(get-response message) :type :groupchat))
(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 ()
"Load the RC file."
(let ((*package* (in-package :org.ryuslash.sil)))
(load (get-rc-location) :if-does-not-exist nil)))
(defun receive ()
- (format t "Recieving~%")
(handler-case (receive-stanza-loop *connection*)
- (simple-error () (receive))))
+ (simple-error (err)
+ (format t "Error: ~A~%" err)
+ (receive))))
(defun sil (args)
(handler-case
(progn
(load-rc)
+ (load-db)
(setf *connection* (connect-tls :hostname *host*))
(auth *connection* *username* *password* *resource*)
(map nil (lambda (ms)
@@ -94,4 +128,5 @@
(receive))
(sb-sys:interactive-interrupt ()
(format t "No! Don't leave me. *sob*~%")))
- (disconnect *connection*))
+ (sqlite:disconnect *db*)
+ (xmpp:disconnect *connection*))