|
@@ -1,5 +1,7 @@
|
|
|
(in-package #:chatikbot)
|
|
(in-package #:chatikbot)
|
|
|
|
|
|
|
|
|
|
+(defvar *admins* nil "Admins chat-ids")
|
|
|
|
|
+
|
|
|
;; Load config file
|
|
;; Load config file
|
|
|
(alexandria:when-let (file (probe-file
|
|
(alexandria:when-let (file (probe-file
|
|
|
(merge-pathnames "config.lisp"
|
|
(merge-pathnames "config.lisp"
|
|
@@ -9,10 +11,10 @@
|
|
|
|
|
|
|
|
;; Init database
|
|
;; Init database
|
|
|
(db-init)
|
|
(db-init)
|
|
|
|
|
+;; Load settings
|
|
|
|
|
+(load-settings)
|
|
|
|
|
|
|
|
(defvar *telegram-last-update* nil "Telegram last update_id")
|
|
(defvar *telegram-last-update* nil "Telegram last update_id")
|
|
|
-(defvar *admins* nil "Admins chat-ids")
|
|
|
|
|
-
|
|
|
|
|
|
|
|
|
|
;; getUpdates handling
|
|
;; getUpdates handling
|
|
|
(defun process-updates ()
|
|
(defun process-updates ()
|
|
@@ -28,25 +30,7 @@
|
|
|
(log:info update)
|
|
(log:info update)
|
|
|
(loop for (key . value) in update
|
|
(loop for (key . value) in update
|
|
|
unless (equal "update_id" key)
|
|
unless (equal "update_id" key)
|
|
|
- do (run-update-hooks (key-to-hook-name key) value)))
|
|
|
|
|
-;;
|
|
|
|
|
-(defun send-response (chat-id response &optional reply-id)
|
|
|
|
|
- (if (consp response)
|
|
|
|
|
- (if (keywordp (car response))
|
|
|
|
|
- (case (car response)
|
|
|
|
|
- (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id))
|
|
|
|
|
- (:voice (telegram-send-voice chat-id (cdr response) :reply-to reply-id))
|
|
|
|
|
- (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id)))
|
|
|
|
|
- (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
|
|
|
|
|
- (telegram-send-message chat-id response :reply-to reply-id)))
|
|
|
|
|
-
|
|
|
|
|
-(defun bot-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
|
|
|
|
|
- (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
|
|
|
|
|
- :disable-web-preview disable-web-preview
|
|
|
|
|
- :reply-to reply-to
|
|
|
|
|
- :reply-markup reply-markup)
|
|
|
|
|
- (error (e)
|
|
|
|
|
- (log:error e))))
|
|
|
|
|
|
|
+ do (run-hooks (string-to-event (format nil "update-~A" key)) value)))
|
|
|
|
|
|
|
|
(defun send-dont-understand (chat-id &optional text reply-id)
|
|
(defun send-dont-understand (chat-id &optional text reply-id)
|
|
|
(let ((resp (eliza text)))
|
|
(let ((resp (eliza text)))
|
|
@@ -60,42 +44,34 @@
|
|
|
(log:info "handle-unknown-message" message)
|
|
(log:info "handle-unknown-message" message)
|
|
|
(send-dont-understand chat-id (preprocess-input text))
|
|
(send-dont-understand chat-id (preprocess-input text))
|
|
|
t))
|
|
t))
|
|
|
-(add-update-hook :message 'handle-unknown-message t)
|
|
|
|
|
-
|
|
|
|
|
-(defun process-watchdog ()
|
|
|
|
|
- (ignore-errors
|
|
|
|
|
- (close
|
|
|
|
|
- (open (merge-pathnames ".watchdog"
|
|
|
|
|
- (asdf:component-pathname
|
|
|
|
|
- (asdf:find-system '#:chatikbot)))
|
|
|
|
|
- :direction :output
|
|
|
|
|
- :if-exists :supersede
|
|
|
|
|
- :if-does-not-exist :create))))
|
|
|
|
|
-
|
|
|
|
|
-(defvar *save-settings-lock* (bordeaux-threads:make-lock "save-settings-lock")
|
|
|
|
|
- "Lock for multithreading access to write settings file")
|
|
|
|
|
-(defun save-settings()
|
|
|
|
|
- (bordeaux-threads:with-lock-held (*save-settings-lock*)
|
|
|
|
|
- (with-open-file (s (merge-pathnames "settings.lisp"
|
|
|
|
|
- (asdf:component-pathname
|
|
|
|
|
- (asdf:find-system '#:chatikbot)))
|
|
|
|
|
- :direction :output
|
|
|
|
|
- :if-exists :supersede
|
|
|
|
|
- :if-does-not-exist :create)
|
|
|
|
|
- (write '(in-package #:chatikbot) :stream s)
|
|
|
|
|
- (write
|
|
|
|
|
- `(setf *chat-locations* ',*chat-locations*
|
|
|
|
|
- *akb-send-to* ',*akb-send-to*
|
|
|
|
|
- *akb-last-id* ,*akb-last-id*)
|
|
|
|
|
- :stream s)
|
|
|
|
|
- (values))))
|
|
|
|
|
-
|
|
|
|
|
-(defvar *schedules* '(process-latest-akb
|
|
|
|
|
- process-latest-checkins
|
|
|
|
|
- process-rates
|
|
|
|
|
- process-feeds
|
|
|
|
|
- process-walls
|
|
|
|
|
- process-watchdog) "Enabled schedules")
|
|
|
|
|
|
|
+(add-hook :update-message 'handle-unknown-message t)
|
|
|
|
|
+
|
|
|
|
|
+;; Schedule
|
|
|
|
|
+(defmacro defcron (name (&rest schedule) &body body)
|
|
|
|
|
+ (let ((schedule (or schedule '(:minute '* :hour '*))))
|
|
|
|
|
+ `(progn
|
|
|
|
|
+ (defun ,name ()
|
|
|
|
|
+ (handler-case (progn ,@body)
|
|
|
|
|
+ (error (e) (log:error e))))
|
|
|
|
|
+ (add-hook :starting #'(lambda ()
|
|
|
|
|
+ (clon:schedule-function
|
|
|
|
|
+ ',name (clon:make-scheduler
|
|
|
|
|
+ (clon:make-typed-cron-schedule
|
|
|
|
|
+ ,@schedule)
|
|
|
|
|
+ :allow-now-p t)
|
|
|
|
|
+ :name ',name :thread t)
|
|
|
|
|
+ (values))))))
|
|
|
|
|
+
|
|
|
|
|
+(defcron process-watchdog ()
|
|
|
|
|
+ (close
|
|
|
|
|
+ (open (merge-pathnames ".watchdog"
|
|
|
|
|
+ (asdf:component-pathname
|
|
|
|
|
+ (asdf:find-system '#:chatikbot)))
|
|
|
|
|
+ :direction :output
|
|
|
|
|
+ :if-exists :supersede
|
|
|
|
|
+ :if-does-not-exist :create)))
|
|
|
|
|
+
|
|
|
|
|
+(defsetting *plugins* nil "List of enabled plugins")
|
|
|
|
|
|
|
|
(defun start ()
|
|
(defun start ()
|
|
|
;; Clear prev threads
|
|
;; Clear prev threads
|
|
@@ -106,38 +82,17 @@
|
|
|
:test #'equal)))
|
|
:test #'equal)))
|
|
|
(when old-updates
|
|
(when old-updates
|
|
|
(bordeaux-threads:destroy-thread old-updates)))
|
|
(bordeaux-threads:destroy-thread old-updates)))
|
|
|
- ;; Load settings file
|
|
|
|
|
- (alexandria:when-let (file (probe-file
|
|
|
|
|
- (merge-pathnames "settings.lisp"
|
|
|
|
|
- (asdf:component-pathname
|
|
|
|
|
- (asdf:find-system '#:chatikbot)))))
|
|
|
|
|
- (load file))
|
|
|
|
|
- ;; Start timers
|
|
|
|
|
- (dolist (func *schedules*)
|
|
|
|
|
- (clon:schedule-function func
|
|
|
|
|
- (clon:make-scheduler
|
|
|
|
|
- (clon:make-typed-cron-schedule :minute '* :hour '*)
|
|
|
|
|
- :allow-now-p t)
|
|
|
|
|
- :name func
|
|
|
|
|
- :thread t))
|
|
|
|
|
- ;; YIT
|
|
|
|
|
- (let ((last-yit-info))
|
|
|
|
|
- (clon:schedule-function
|
|
|
|
|
- #'(lambda() (let ((info (yit-info)))
|
|
|
|
|
- (when (not (equal info last-yit-info))
|
|
|
|
|
- (send-response (car *admins*) info)
|
|
|
|
|
- (setf last-yit-info info))))
|
|
|
|
|
- (clon:make-scheduler
|
|
|
|
|
- (clon:make-typed-cron-schedule :minute 0 :hour '*)
|
|
|
|
|
- :allow-now-p t)
|
|
|
|
|
- :name "YIT" :thread t))
|
|
|
|
|
-
|
|
|
|
|
- ;; Nalunch
|
|
|
|
|
- (clon:schedule-function
|
|
|
|
|
- #'process-nalunch (clon:make-scheduler (clon:make-typed-cron-schedule
|
|
|
|
|
- :minute '(member 0 15 30 45))
|
|
|
|
|
- :allow-now-p t)
|
|
|
|
|
- :name "Nalunch" :thread t)
|
|
|
|
|
|
|
+
|
|
|
|
|
+ ;; Load plugins
|
|
|
|
|
+ (dolist (plugin *plugins*)
|
|
|
|
|
+ (handler-case
|
|
|
|
|
+ (load (merge-pathnames (format nil "~A.lisp" plugin)
|
|
|
|
|
+ (asdf:component-pathname
|
|
|
|
|
+ (asdf:find-system '#:chatikbot))))
|
|
|
|
|
+ (error (e) (log:error e))))
|
|
|
|
|
+
|
|
|
|
|
+ ;; Run 'starting' hooks to set up schedules
|
|
|
|
|
+ (run-hooks :starting)
|
|
|
|
|
|
|
|
;; Start getUpdates thread
|
|
;; Start getUpdates thread
|
|
|
(bordeaux-threads:make-thread
|
|
(bordeaux-threads:make-thread
|