chatikbot.lisp 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. (in-package :cl-user)
  2. (defpackage chatikbot
  3. (:use :cl)
  4. (:import-from :chatikbot.db
  5. :with-db
  6. :db-init
  7. :db-execute
  8. :db-select
  9. :load-settings)
  10. (:import-from :chatikbot.utils
  11. :*bot-name*
  12. :*admins*
  13. :aget
  14. :flatten
  15. :format-ts
  16. :run-hooks
  17. :loop-with-error-backoff)
  18. (:import-from :chatikbot.telegram
  19. :*telegram-token*
  20. :telegram-get-me
  21. :telegram-set-webhook
  22. :telegram-send-message)
  23. (:import-from :chatikbot.secrets
  24. :*secret-ring*
  25. :*secret-pass-store*
  26. :*secret-pass-bin*)
  27. (:import-from :chatikbot.macros
  28. :defcron)
  29. (:import-from :chatikbot.bot
  30. :process-updates
  31. :*bot-user-id*)
  32. (:import-from :chatikbot.server
  33. :*web-path*
  34. :*web-iface*
  35. :*web-port*)
  36. (:export :start))
  37. (in-package :chatikbot)
  38. (defvar *plugins* nil "list of enabled plugins.")
  39. (defun plugins-db-init ()
  40. (db-execute "create table if not exists plugins (name)")
  41. (db-execute "create unique index if not exists plugins_name_unique on plugins (name)"))
  42. (defun enable-plugin (name)
  43. (load (merge-pathnames (format nil "plugins/~A.lisp" name)
  44. (asdf:component-pathname
  45. (asdf:find-system '#:chatikbot))))
  46. (db-execute "replace into plugins (name) values (?)" name)
  47. (push name *plugins*))
  48. (defun disable-plugin (name)
  49. (db-execute "delete from plugins where name = ?" name)
  50. (setf *plugins* (delete name *plugins* :test #'equal)))
  51. (eval-when (:load-toplevel :execute)
  52. ;; Load config file
  53. (alexandria:when-let (file (probe-file
  54. (merge-pathnames "config.lisp"
  55. (asdf:component-pathname
  56. (asdf:find-system '#:chatikbot)))))
  57. (load file))
  58. ;; Init database
  59. (db-init)
  60. ;; Load plugins
  61. (plugins-db-init)
  62. (setf *plugins* (flatten (db-select "select name from plugins")))
  63. (dolist (plugin *plugins*)
  64. (handler-case
  65. (load (merge-pathnames (format nil "plugins/~A.lisp" plugin)
  66. (asdf:component-pathname
  67. (asdf:find-system '#:chatikbot))))
  68. (error (e) (log:error e))))
  69. ;; Load settings
  70. (load-settings)
  71. ;; Init plugin's database
  72. (with-db (db)
  73. (run-hooks :db-init)))
  74. (defcron process-watchdog ()
  75. (close
  76. (open (merge-pathnames ".watchdog"
  77. (asdf:component-pathname
  78. (asdf:find-system '#:chatikbot)))
  79. :direction :output
  80. :if-exists :supersede
  81. :if-does-not-exist :create)))
  82. (defun cleanup ()
  83. ;; Clear prev threads
  84. (mapc #'trivial-timers:unschedule-timer (trivial-timers:list-all-timers))
  85. (let ((old-updates (find "process-updates"
  86. (bordeaux-threads:all-threads)
  87. :key #'bordeaux-threads:thread-name
  88. :test #'equal)))
  89. (when old-updates
  90. (bordeaux-threads:destroy-thread old-updates))))
  91. (defun start ()
  92. ;; Test telegram token
  93. (setf *bot-name* (concatenate 'string "@" (aget "username" (telegram-get-me)))
  94. *bot-user-id* (parse-integer *telegram-token*
  95. :end (position #\: *telegram-token*)))
  96. (cleanup)
  97. ;; Run 'starting' hooks to set up schedules
  98. (run-hooks :starting)
  99. (if *web-path*
  100. ;; If *web-path* is set, use webhooks
  101. (telegram-set-webhook (format nil "~A/~A" *web-path* *telegram-token*))
  102. ;; else start getUpdates thread
  103. (progn
  104. (telegram-set-webhook "") ;; Disable webhooks if present
  105. (bordeaux-threads:make-thread
  106. (lambda () (loop-with-error-backoff #'process-updates))
  107. :name "process-updates")))
  108. ;; Notify admins
  109. (dolist (admin *admins*)
  110. (ignore-errors
  111. (telegram-send-message admin (format nil "~A started at ~A" *bot-name* (format-ts (local-time:now)))))))