Tom Willemse
0cd2ad09ce
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.
132 lines
4.2 KiB
Common Lisp
132 lines
4.2 KiB
Common Lisp
;; Copyright (C) 2013 Tom Willemsen <tom at ryuslash dot org>
|
|
|
|
;; This file is part of Sil
|
|
|
|
;; Sil is free software: you can redistribute it and/or modify it
|
|
;; under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; Sil is distributed in the hope that it will be useful, but WITHOUT
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
|
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
|
|
;; License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with Sil. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Code:
|
|
|
|
(in-package :org.ryuslash.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.")
|
|
|
|
(defvar *username* nil
|
|
"The username to log-in with, should not contain the jabber host.")
|
|
|
|
(defvar *password* nil
|
|
"The password to log-in with.")
|
|
|
|
(defvar *resource* nil
|
|
"The resource to use when logging in.")
|
|
|
|
(defvar *muc-rooms-alist* nil
|
|
"Any MUCs to join.")
|
|
|
|
(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_CONFIG_HOME"))
|
|
(home (sb-ext:posix-getenv "HOME")))
|
|
(pathname
|
|
(apply 'concatenate 'string
|
|
(or xdg home)
|
|
(unless xdg "/.config")
|
|
'("/sil/rc.lisp")))))
|
|
|
|
(defun get-response (message)
|
|
(cond
|
|
((string-equal (body message) "date")
|
|
(multiple-value-bind (second minute hour date month year day
|
|
daylight-p zone) (get-decoded-time)
|
|
(declare (ignore day daylight-p zone))
|
|
(format nil "Date: ~D-~D-~D ~D:~D:~D" date month year hour
|
|
minute second)))
|
|
(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))
|
|
(xmpp:message connection "aethon@muc.ryuslash.org"
|
|
(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 ()
|
|
(handler-case (receive-stanza-loop *connection*)
|
|
(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)
|
|
(join-chatroom *connection* :room ms :from *jid*))
|
|
*muc-rooms-alist*)
|
|
(receive))
|
|
(sb-sys:interactive-interrupt ()
|
|
(format t "No! Don't leave me. *sob*~%")))
|
|
(sqlite:disconnect *db*)
|
|
(xmpp:disconnect *connection*))
|