1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
;; 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*))
|
