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:
parent
7421364315
commit
0cd2ad09ce
3 changed files with 46 additions and 9 deletions
|
@ -18,4 +18,6 @@
|
|||
;;; Code:
|
||||
|
||||
(defpackage :org.ryuslash.sil
|
||||
(:use :cl :xmpp))
|
||||
(:use :cl :xmpp :sqlite)
|
||||
(:shadow :connect :disconnect)
|
||||
(:export :sil))
|
||||
|
|
|
@ -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")))
|
||||
|
|
|
@ -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*))
|
||||
|
|
Loading…
Reference in a new issue