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.

1 files changed, 42 insertions, 7 deletions

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*))