[REFACTOR] Packagize!

bot.lisp

@@ -0,0 +1,51 @@
+(in-package :cl-user)
+(defpackage chatikbot.bot
+  (:use :cl :chatikbot.utils :chatikbot.macros)
+  (:import-from :chatikbot.db
+                :set-setting)
+  (:import-from :chatikbot.telegram
+                :telegram-get-updates
+                :send-response)
+  (:export :handle-update))
+(in-package :chatikbot.bot)
+
+(defvar *telegram-last-update* 0 "Telegram last update_id")
+
+;; getUpdates handling
+(defun process-updates ()
+  (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
+                                                         (1+ *telegram-last-update*))
+                                            :timeout 300)
+     ;; do (setf *telegram-last-update*
+     ;;          (max *telegram-last-update* (aget "update_id" update)))
+     do (handle-update update)))
+
+(defun handle-update (update)
+  (log:info update)
+  (let ((update-id (aget "update_id" update))
+        (reply-to (aget "id" (aget "from" (aget "reply_to_message" (aget "message" update))))))
+    (if (> update-id *telegram-last-update*)
+        (progn
+          (if (and reply-to (not (equal reply-to *bot-user-id*)))
+              (log:info "Reply not to bot")
+              (loop for (key . value) in update
+                 unless (equal "update_id" key)
+                 do (run-hooks (keyify (format nil "update-~A" key)) value)))
+          (setf *telegram-last-update* update-id))
+        (log:warn "Out-of-order update" update-id))))
+
+(defvar *start-message* "Hello" "Welcome message. Override it")
+(def-message-cmd-handler handle-start (:start)
+  (send-response chat-id *start-message*))
+
+(def-message-admin-cmd-handler handle-admin-settings (:settings)
+  (send-response chat-id
+                 (format nil "~{~{~A~@[ (~A)~]: ~A~}~^~%~}"
+                         (loop for symbol in *settings*
+                            collect (list symbol (documentation symbol 'variable) (symbol-value symbol))))))
+
+(def-message-admin-cmd-handler handle-admin-setsetting (:setsetting)
+  (let* ((*package* (find-package :chatikbot))
+         (var (read-from-string (car args)))
+         (val (read-from-string (format nil "~{~A~^ ~}" (rest args)))))
+    (send-response chat-id (format nil "OK, ~A" (set-setting var val)))))

chatikbot.asd

@@ -23,11 +23,15 @@
                #:quri
                #:yason)
   :serial t
-  :components ((:file "package")
-               (:file "patmatch")
+  :components ((:file "patmatch")
                (:file "utils")
+               (:file "eliza")
                (:file "secrets")
                (:file "db")
                (:file "telegram")
+               (:file "crypto")
+               (:file "macros")
+               (:file "bot")
                (:file "server")
+               (:file "common")
                (:file "chatikbot")))

chatikbot.lisp

@@ -1,71 +1,86 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot
+  (:use :cl)
+  (:import-from :chatikbot.db
+                :with-db
+                :db-init
+                :db-execute
+                :db-select
+                :load-settings)
+  (:import-from :chatikbot.utils
+                :*bot-name*
+                :*admins*
+                :aget
+                :flatten
+                :format-ts
+                :run-hooks
+                :loop-with-error-backoff)
+  (:import-from :chatikbot.telegram
+                :*telegram-token*
+                :telegram-get-me
+                :telegram-set-webhook
+                :telegram-send-message
+                :send-response)
+  (:import-from :chatikbot.secrets
+                :*secret-ring*
+                :*secret-pass-store*
+                :*secret-pass-bin*)
+  (:import-from :chatikbot.macros
+                :defcron)
+  (:import-from :chatikbot.bot
+                :process-updates)
+  (:import-from :chatikbot.server
+                :*web-path*
+                :*web-iface*
+                :*web-port*)
+  (:export :start))
+
+(in-package :chatikbot)
 
-(defvar *admins* nil "Admins chat-ids")
 (defvar *bot-user-id* nil "Bot user_id")
+(defvar *plugins* nil "list of enabled plugins.")
+
+(defun plugins-db-init ()
+  (db-execute "create table if not exists plugins (name)")
+  (db-execute "create unique index if not exists plugins_name_unique on plugins (name)"))
+
+(defun enable-plugin (name)
+  (load (merge-pathnames (format nil "plugins/~A.lisp" name)
+                         (asdf:component-pathname
+                          (asdf:find-system '#:chatikbot))))
+  (db-execute "replace into plugins (name) values (?)" name)
+  (push name *plugins*))
+
+(defun disable-plugin (name)
+  (db-execute "delete from plugins where name = ?" name)
+  (setf *plugins* (delete name *plugins* :test #'equal)))
+
+(eval-when (:load-toplevel :execute)
+  ;; Load config file
+  (alexandria:when-let (file (probe-file
+                              (merge-pathnames "config.lisp"
+                                               (asdf:component-pathname
+                                                (asdf:find-system '#:chatikbot)))))
+    (load file))
+
+  ;; Init database
+  (db-init)
+
+  ;; Load plugins
+  (plugins-db-init)
+  (setf *plugins* (flatten (db-select "select name from plugins")))
+  (dolist (plugin *plugins*)
+    (handler-case
+        (load (merge-pathnames (format nil "plugins/~A.lisp" plugin)
+                               (asdf:component-pathname
+                                (asdf:find-system '#:chatikbot))))
+      (error (e) (log:error e))))
+  ;; Load settings
+  (load-settings)
+  ;; Init plugin's database
+  (with-db (db)
+    (run-hooks :db-init)))
 
-;; Load config file
-(alexandria:when-let (file (probe-file
-                            (merge-pathnames "config.lisp"
-                                             (asdf:component-pathname
-                                              (asdf:find-system '#:chatikbot)))))
-  (load file))
-
-;; Init database
-(db-init)
-;; Load settings
-(load-settings)
-;; Load plugins
-(defsetting *plugins* nil "List of enabled plugins")
-(dolist (plugin *plugins*)
-  (handler-case
-      (load (merge-pathnames (format nil "plugins/~A.lisp" plugin)
-                             (asdf:component-pathname
-                              (asdf:find-system '#:chatikbot))))
-    (error (e) (log:error e))))
-;; Init plugin's database
-(with-db (db)
-  (run-hooks :db-init))
-
-(defvar *telegram-last-update* 0 "Telegram last update_id")
-
-;; getUpdates handling
-(defun process-updates ()
-  (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
-                                                         (1+ *telegram-last-update*))
-                                            :timeout 300)
-     ;; do (setf *telegram-last-update*
-     ;;          (max *telegram-last-update* (aget "update_id" update)))
-     do (handle-update update)))
-
-(defun handle-update (update)
-  (log:info update)
-  (let ((update-id (aget "update_id" update))
-        (reply-to (aget "id" (aget "from" (aget "reply_to_message" (aget "message" update))))))
-    (if (> update-id *telegram-last-update*)
-        (progn
-          (if (and reply-to (not (equal reply-to *bot-user-id*)))
-              (log:info "Reply not to bot")
-              (loop for (key . value) in update
-                 unless (equal "update_id" key)
-                 do (run-hooks (keyify (format nil "update-~A" key)) value)))
-          (setf *telegram-last-update* update-id))
-        (log:warn "Out-of-order update" update-id))))
-
-(defvar *start-message* "Hello" "Welcome message. Override it")
-(def-message-cmd-handler handle-start (:start)
-  (send-response chat-id *start-message*))
-
-(def-message-admin-cmd-handler handle-admin-settings (:settings)
-  (send-response chat-id
-                 (format nil "~{~{~A~@[ (~A)~]: ~A~}~^~%~}"
-                         (loop for symbol in *settings*
-                            collect (list symbol (documentation symbol 'variable) (symbol-value symbol))))))
-
-(def-message-admin-cmd-handler handle-admin-setsetting (:setsetting)
-  (let* ((*package* (find-package :chatikbot))
-         (var (read-from-string (car args)))
-         (val (read-from-string (format nil "~{~A~^ ~}" (rest args)))))
-    (send-response chat-id (format nil "OK, ~A" (set-setting var val)))))
 
 (defcron process-watchdog ()
   (close

common.lisp

@@ -0,0 +1,123 @@
+(in-package :cl-user)
+(defpackage chatikbot.common
+  (:use :cl
+        :chatikbot.db
+        :chatikbot.utils
+        :chatikbot.telegram
+        :chatikbot.crypto
+        :chatikbot.secrets
+        :chatikbot.server
+        :chatikbot.macros)
+  (:export :db-transaction
+           :db-execute
+           :db-select
+           :db-single
+           :set-setting
+           :lists-set-entry
+           :lists-get
+           :*admins*
+           :*bot-name*
+           :add-hook
+           :remove-hook
+           :keyify
+           :dekeyify
+           :*settings*
+           :defsetting
+           :*backoff-start*
+           :*backoff-max*
+           :loop-with-error-backoff
+           :replace-all
+           :aget
+           :agets
+           :mappend
+           :random-elt
+           :flatten
+           :preprocess-input
+           :spaced
+           :http-request
+           :xml-request
+           :get-by-tag
+           :select-text
+           :trim-nil
+           :text-with-cdata
+           :child-text
+           :clean-text
+           :json-request
+           :plist-hash
+           :plist-json
+           :format-ts
+           :parse-float
+           :smart-f
+           :format-size
+           :format-interval
+           :symbol-append
+           :telegram-get-me
+           :telegram-send-message
+           :telegram-forward-message
+           :telegram-send-photo
+           :telegram-send-audio
+           :telegram-send-document
+           :telegram-send-sticker
+           :telegram-send-video
+           :telegram-send-voice
+           :telegram-send-location
+           :telegram-send-chat-action
+           :telegram-send-get-user-profile-photos
+           :telegram-send-get-file
+           :telegram-answer-callback-query
+           :telegram-edit-message-text
+           :telegram-edit-message-caption
+           :telegram-edit-message-reply-markup
+           :telegram-answer-inline-query
+           :telegram-file-contents
+           :telegram-inline-keyboard-markup
+           :telegram-reply-keyboard-markup
+           :telegram-reply-keyboard-hide
+           :telegram-force-reply
+           :send-response
+           :bot-send-message
+           :token-hmac
+           :encode-callback-data
+           :decode-callback-data
+           :encode-oauth-state
+           :decode-oauth-state
+           :secret-get
+           :secret-set
+           :secret-del
+           :secret-wipe
+           :with-secret
+           :def-db-init
+           :def-webhook-handler
+           :get-webhook-url
+           :get-oauth-url
+           :hook
+           :data
+           :headers
+           :paths
+           :def-db-init
+           :def-message-handler
+           :message-id
+           :from-id
+           :chat-id
+           :text
+           :def-message-cmd-handler
+           :def-message-admin-cmd-handler
+           :cmd
+           :args
+           :def-callback-handler
+           :query-id
+           :from
+           :raw-data
+           :message
+           :inline-message-id
+           :def-callback-section-handler
+           :data
+           :section
+           :def-oauth-handler
+           :def-oauth-section-handler
+           :code
+           :error
+           :raw-state
+           :state
+           :defcron))
+(in-package :chatikbot.common)

crypto.lisp

@@ -0,0 +1,53 @@
+(in-package :cl-user)
+(defpackage chatikbot.crypto
+  (:use :cl)
+  (:import-from :chatikbot.telegram
+                :*telegram-token*
+                :+telegram-max-callback-data-length+)
+  (:export :token-hmac
+           :encode-callback-data
+           :decode-callback-data
+           :encode-oauth-state
+           :decode-oauth-state))
+(in-package #:chatikbot.crypto)
+
+(defun token-hmac (message &optional (hmac-length 12))
+  (let ((hmac (crypto:make-hmac (crypto:ascii-string-to-byte-array *telegram-token*) :sha256)))
+    (crypto:update-hmac hmac (crypto:ascii-string-to-byte-array message))
+    (base64:usb8-array-to-base64-string
+     (subseq (crypto:hmac-digest hmac) 0 hmac-length) :uri t)))
+
+(defun encode-callback-data (chat-id section data &optional (ttl 600) (hmac-length 12))
+  (when (find #\: data)
+    (error "Bad data."))
+  (let* ((message (format nil "~A:~A:~A:~A"
+                          (base64:integer-to-base64-string chat-id)
+                          (base64:integer-to-base64-string
+                           (+ ttl (local-time:timestamp-to-universal (local-time:now))))
+                          section data))
+         (encoded (format nil "~A$~A" message (token-hmac message hmac-length))))
+    (when (> (length encoded) +telegram-max-callback-data-length+)
+      (error "Max callback length exceeded"))
+    encoded))
+
+(defun decode-callback-data (chat-id raw-data &optional (hmac-length 12))
+  (destructuring-bind (message hmac)
+      (split-sequence:split-sequence #\$ raw-data :from-end t :count 2)
+    (destructuring-bind (cid expire section data)
+        (split-sequence:split-sequence #\: message :count 4)
+      (unless (= chat-id (base64:base64-string-to-integer cid))
+        (error "Wrong chat id."))
+      (unless (>= (base64:base64-string-to-integer expire)
+                  (local-time:timestamp-to-universal (local-time:now)))
+        (error "Expired."))
+      (unless (equal hmac (token-hmac message hmac-length))
+        (error "Bad data."))
+      (values data (intern (string-upcase section) "KEYWORD")))))
+
+(defun encode-oauth-state (section state)
+  (format nil "~A$~A" section state))
+
+(defun decode-oauth-state (raw-state)
+  (destructuring-bind (section data)
+      (split-sequence:split-sequence #\$ raw-state :count 2)
+    (values data (intern (string-upcase section) "KEYWORD"))))

db.lisp

@@ -1,4 +1,18 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.db
+  (:use :cl)
+  (:import-from :chatikbot.utils
+                :dekeyify)
+  (:export :db-transaction
+           :db-execute
+           :db-select
+           :db-single
+           :db-init
+           :load-settings
+           :set-setting
+           :lists-set-entry
+           :lists-get))
+(in-package :chatikbot.db)
 
 (defvar *db-name* "db.sqlite" "SQLite database name")
 
@@ -43,12 +57,6 @@
   (with-db (db)
     (apply #'sqlite:execute-single db sql parameters)))
 
-(defmacro def-db-init (&body body)
-  `(add-hook :db-init #'(lambda ()
-                          (handler-case (progn ,@body)
-                            (error (e) (log:error e)))
-                          (values))))
-
 (defun db-init ()
   (with-db (db)
     (db-execute "create table if not exists settings (var, val)")
@@ -59,15 +67,15 @@
 (defun load-settings ()
   (let ((*package* (find-package :chatikbot)))
     (loop for (var val) in (db-select "select var, val from settings")
-       do (setf (symbol-value (intern var))
-                (handler-case (read-from-string val)
-                  (error (e) (log:error e)))))))
+       do (handler-case (setf (symbol-value (read-from-string var))
+                              (read-from-string val))
+            (error (e) (log:error "~A" e))))))
 
 (defun set-setting (symbol value)
   (handler-case
       (let ((*package* (find-package :chatikbot)))
         (db-execute "replace into settings (var, val) values (?, ?)"
-                    (symbol-name symbol)
+                    (write-to-string symbol)
                     (write-to-string value))
         (setf (symbol-value symbol) value))
     (error (e) (log:error e))))

eliza.lisp

@@ -0,0 +1,46 @@
+(in-package :cl-user)
+(defpackage chatikbot.eliza
+  (:use :cl
+        :chatikbot.patmatch
+        :chatikbot.utils)
+  (:export :?is
+           :?or
+           :?and
+           :?not
+           :?*
+           :?+
+           :??
+           :?if
+           :eliza
+           :read-from-string-no-punct))
+(in-package :chatikbot.eliza)
+
+(defun punctuation-p (char)
+  (find char ".,;:'!?#-()\\\""))
+
+(defun read-from-string-no-punct (input)
+  "Read from an input string, ignoring punctuation."
+  (read-from-string
+   (concatenate 'string "(" (substitute-if #\space #'punctuation-p input) ")")))
+
+(defun switch-viewpoint (words)
+  "Change I to you and vice versa, and so on."
+  (sublis '((I . you) (you . I) (me . you) (am . are)
+            (я ты) (ты я) (меня тебя) (тебя меня))
+          words))
+
+(defun use-eliza-rules (input rules)
+  "Find some rule with which to transform the input."
+  (rule-based-translator input rules
+                         :action #'(lambda (bindings responses)
+                                     (sublis (switch-viewpoint bindings)
+                                             (random-elt responses)))))
+
+(defun eliza (input rules)
+  (let ((r (use-eliza-rules input rules)))
+    (cond
+      ((null r) nil)
+      ((and (consp (car r)) (eq 'function (caar r)))
+       (apply (cadar r) (cdr r)))
+      ((keywordp (car r)) r)
+      (t (print-with-spaces (flatten r))))))

macros.lisp

@@ -0,0 +1,120 @@
+(in-package :cl-user)
+(defpackage chatikbot.macros
+  (:use :cl :chatikbot.utils :chatikbot.telegram :chatikbot.crypto)
+  (:export :def-db-init
+           :def-message-handler
+           :def-message-cmd-handler
+           :def-message-admin-cmd-handler
+           :def-callback-handler
+           :def-callback-section-handler
+           :def-oauth-handler
+           :def-oauth-section-handler
+           :defcron))
+(in-package #:chatikbot.macros)
+
+(defmacro def-db-init (&body body)
+  `(add-hook :db-init #'(lambda ()
+                          (handler-case (progn ,@body)
+                            (error (e) (log:error e)))
+                          (values))))
+
+(defmacro def-message-handler (name (message) &body body)
+  `(progn
+     (defun ,name (,message)
+       (let ((message-id (aget "message_id" ,message))
+             (from-id (aget "id" (aget "from" ,message)))
+             (chat-id (aget "id" (aget "chat" ,message)))
+             (text (aget "text" ,message)))
+         (declare (ignorable message-id from-id chat-id text))
+         (handler-case (progn ,@body)
+           (error (e)
+             (log:error "~A" e)
+             (bot-send-message chat-id
+                               (format nil "Ошибочка вышла~@[: ~A~]"
+                                       (when (member chat-id *admins*) e)))))))
+     (add-hook :update-message ',name)))
+
+(defmacro def-message-cmd-handler (name (&rest commands) &body body)
+  `(def-message-handler ,name (message)
+     (when (and text (equal #\/ (char text 0)))
+       (multiple-value-bind (cmd args) (parse-cmd text)
+         (when (member cmd (list ,@commands))
+           (log:info cmd message-id chat-id from-id args)
+           ,@body
+           t)))))
+
+(defmacro def-message-admin-cmd-handler (name (&rest commands) &body body)
+  `(def-message-handler ,name (message)
+     (when (and (member chat-id *admins*)
+                text (equal #\/ (char text 0)))
+       (multiple-value-bind (cmd args) (parse-cmd text)
+         (when (member cmd (list ,@commands))
+           (log:info cmd message-id chat-id from-id args)
+           ,@body
+           t)))))
+
+(defmacro def-callback-handler (name (callback) &body body)
+  `(progn
+     (defun ,name (,callback)
+       (let* ((query-id (aget "id" ,callback))
+              (from (aget "from" ,callback))
+              (raw-data (aget "data" ,callback))
+              (message (aget "message" ,callback))
+              (inline-message-id (aget "inline_message_id" ,callback))
+              (from-id (aget "id" from))
+              (chat-id (aget "id" (aget "chat" message)))
+              (message-id (aget "message_id" message)))
+         (declare (ignorable query-id from raw-data message inline-message-id from-id chat-id message-id))
+         (handler-case (progn ,@body)
+           (error (e)
+             (log:error "~A" e)
+             (bot-send-message (or chat-id from-id)
+                               (format nil "Ошибочка вышла~@[: ~A~]"
+                                       (when (member chat-id *admins*) e)))))))
+     (add-hook :update-callback-query ',name)))
+
+(defmacro def-callback-section-handler (name (&rest sections) &body body)
+  `(def-callback-handler ,name (callback)
+     (when chat-id
+       (multiple-value-bind (data section) (decode-callback-data chat-id raw-data)
+         (when (member section (list ,@sections))
+           (log:info query-id from-id chat-id message-id section data)
+           ,@body
+           t)))))
+
+(defmacro def-oauth-handler (name (code error state) &body body)
+  `(progn
+     (defun ,name (,code ,error ,state)
+       (declare (ignorable ,code ,error ,state))
+       (handler-case (progn ,@body)
+         (error (e)
+           (log:error "~A" e)
+           (hunchentoot:redirect "/error"))))
+     (add-hook :oauth ',name)))
+
+(defmacro def-oauth-section-handler (name (&rest sections) &body body)
+  `(def-oauth-handler ,name (code error raw-state)
+     (multiple-value-bind (state section) (decode-oauth-state raw-state)
+       (when (member section (list ,@sections))
+         ,@body
+         t))))
+
+;; Schedule
+(defmacro defcron (name (&rest schedule) &body body)
+  (let ((schedule (or schedule '(:minute '* :hour '*)))
+        (scheduler (symbol-append name '-scheduler)))
+    `(progn
+       (defun ,name ()
+         (unwind-protect
+              (handler-case (progn ,@body)
+                (error (e) (log:error e)))
+           (dex:clear-connection-pool)))
+       (defun ,scheduler ()
+         (clon:schedule-function
+          ',name (clon:make-scheduler
+                  (clon:make-typed-cron-schedule
+                   ,@schedule)
+                  :allow-now-p t)
+          :name ',name :thread t)
+         (values))
+       (add-hook :starting ',scheduler))))

package.lisp

@@ -1,5 +0,0 @@
-(defpackage #:chatikbot
-  (:use #:cl)
-  (:export #:start))
-
-(in-package #:chatikbot)

patmatch.lisp

@@ -8,7 +8,19 @@
 
 ;;; The basic are in auxfns.lisp; look for "PATTERN MATCHING FACILITY"
 
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.patmatch
+  (:use :cl)
+  (:export :?is
+           :?or
+           :?and
+           :?not
+           :?*
+           :?+
+           :??
+           :?if
+           :rule-based-translator))
+(in-package #:chatikbot.patmatch)
 
 (defconstant fail nil "Indicates pat-match failure")
 
@@ -45,13 +57,13 @@
         ((variable-p pattern)
          (match-variable pattern input bindings))
         ((eql pattern input) bindings)
-        ((segment-pattern-p pattern)                
-         (segment-matcher pattern input bindings))  
+        ((segment-pattern-p pattern)
+         (segment-matcher pattern input bindings))
         ((single-pattern-p pattern)                 ; ***
          (single-matcher pattern input bindings))   ; ***
-        ((and (consp pattern) (consp input)) 
+        ((and (consp pattern) (consp input))
          (pat-match (rest pattern) (rest input)
-                    (pat-match (first pattern) (first input) 
+                    (pat-match (first pattern) (first input)
                                bindings)))
         (t fail)))
 
@@ -68,7 +80,7 @@
 
 (defun segment-pattern-p (pattern)
   "Is this a segment-matching pattern like ((?* var) . pat)?"
-  (and (consp pattern) (consp (first pattern)) 
+  (and (consp pattern) (consp (first pattern))
        (symbolp (first (first pattern)))
        (segment-match-fn (first (first pattern)))))
 
@@ -89,12 +101,12 @@
            (rest pattern) input bindings))
 
 (defun segment-match-fn (x)
-  "Get the segment-match function for x, 
+  "Get the segment-match function for x,
   if it is a symbol that has one."
   (when (symbolp x) (get x 'segment-match)))
 
 (defun single-match-fn (x)
-  "Get the single-match function for x, 
+  "Get the single-match function for x,
   if it is a symbol that has one."
   (when (symbolp x) (get x 'single-match)))
 
@@ -121,7 +133,7 @@
   "Succeed if any one of the patterns match the input."
   (if (null patterns)
       fail
-      (let ((new-bindings (pat-match (first patterns) 
+      (let ((new-bindings (pat-match (first patterns)
                                      input bindings)))
         (if (eq new-bindings fail)
             (match-or (rest patterns) input bindings)
@@ -179,11 +191,11 @@
   (and (progv (mapcar #'car bindings)
               (mapcar #'cdr bindings)
           (eval (second (first pattern))))
-       (pat-match (rest pattern) input bindings)))  
+       (pat-match (rest pattern) input bindings)))
 
 (defun pat-match-abbrev (symbol expansion)
   "Define symbol as a macro standing for a pat-match pattern."
-  (setf (get symbol 'expand-pat-match-abbrev) 
+  (setf (get symbol 'expand-pat-match-abbrev)
     (expand-pat-match-abbrev expansion)))
 
 (defun expand-pat-match-abbrev (pat)

plugins/admin.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.admin
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.admin)
 
 (defmacro handling-errors (&body body)
   `(handler-case (progn ,@body)
@@ -15,7 +18,7 @@
 (defun rep (input)
   (when input
     (with-output-to-string (*standard-output*)
-      (let ((*package* (find-package 'chatikbot))
+      (let ((*package* (find-package 'chatikbot.common))
             (*error-output* *standard-output*))
         (handling-errors
           (format t "~{~S~^ ;~%     ~}~%"

plugins/finance.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.finance
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.finance)
 
 (defparameter +yahoo-url+ "https://query1.finance.yahoo.com/v7/finance/quote?lang=en-US&region=US&corsDomain=finance.yahoo.com&fields=regularMarketPrice" "Yahoo Finance API endpoint")
 (defparameter +brent-url+ "http://www.cmegroup.com/CmeWS/mvc/Quotes/Future/424/G")

plugins/forecast.lisp

@@ -1,4 +1,8 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.forecast
+  (:use :cl :chatikbot.common)
+  (:export :*forecast-api-key*))
+(in-package :chatikbot.plugins.forecast)
 
 (defsetting *forecast-api-key* nil "forecast.io APIKEY")
 (defparameter +forecast-api-url+ "https://api.darksky.net/forecast" "forecast.io API endpoint")

plugins/foursquare.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.foursquare
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.foursquare)
 
 (defparameter *fsq-checkins-url* "https://api.foursquare.com/v2/checkins/recent"
   "URL of recent checkins API")
@@ -192,6 +195,8 @@
       (when users
         (bot-send-message chat-id
                           (format nil "~{~A~^~%~}"
-                                  (loop for checkin in (fsq-fetch-checkins token)
-                                     if (member (aget "id" (aget "user" checkin)) users :test #'equal)
-                                     collect (fsq-format-checkin checkin t))))))))
+                                  (or
+                                   (loop for checkin in (fsq-fetch-checkins token)
+                                      if (member (aget "id" (aget "user" checkin)) users :test #'equal)
+                                      collect (fsq-format-checkin checkin t))
+                                   '("Нету"))))))))

plugins/google.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.google
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.google)
 
 (defparameter +google-search-url+ "http://www.google.com/search")
 
@@ -13,8 +16,8 @@
      when (and q (equal (quri:uri-path uri) "/url"))
      collect (list
               (cons :url q)
-              (cons :title (select-text "" a))
-              (cons :desc (select-text ".st" result)))))
+              (cons :title (select-text a))
+              (cons :desc (select-text result ".st")))))
 
 (defun google-format-search-results (results)
   (format nil "~{~A. ~A~^~%~}"

plugins/gsheets.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.gsheets
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.gsheets)
 
 (defsetting *gsheets-client-id* nil "google oauth2 client id")
 (defsetting *gsheets-client-secret* nil "client secret")
@@ -29,9 +32,7 @@
     (quri:make-uri :query (quri:url-encode-params
                            `(("response_type" . "code")
                              ("client_id" . ,*gsheets-client-id*)
-                             ("redirect_uri" . ,(quri:render-uri
-                                                 (quri:merge-uris (quri:uri "/oauth")
-                                                                  (quri:uri *web-path*))))
+                             ("redirect_uri" . ,(get-oauth-url))
                              ("scope" . ,+gsheets-scope+)
                              ("state" . ,(encode-oauth-state :gsheets state))
                              ("access_type" . "offline")
@@ -63,9 +64,7 @@
                                              (cons "code" code)
                                              (cons "client_id" *gsheets-client-id*)
                                              (cons "client_secret" *gsheets-client-secret*)
-                                             (cons "redirect_uri" (quri:render-uri
-                                                                   (quri:merge-uris (quri:uri "/oauth")
-                                                                                    (quri:uri *web-path*))))
+                                             (cons "redirect_uri" (get-oauth-url))
                                              (cons "grant_type" "authorization_code"))))
                (access-token (aget "access_token" resp))
                (refresh-token (aget "refresh_token" resp))
@@ -93,7 +92,7 @@
            (response (json-request
                       (quri:render-uri (quri:merge-uris (quri:make-uri :path path) (quri:uri base-url)))
                       :method method :parameters parameters :content content
-                      :additional-headers (list (cons "Authorization" (format nil "Bearer ~A" access-token)))))
+                      :headers (list (cons "Authorization" (format nil "Bearer ~A" access-token)))))
            (err (aget "error" response)))
       (if (and err (equal 401 (aget "code" err)) (not is-retry) (gsheets-refresh-access-token token-id))
           ;; Retry in case of auth error and successful token refresh
@@ -116,9 +115,7 @@
                      (list "kind" "api#channel"
                            "id" (princ-to-string (uuid:make-v4-uuid))
                            "type" "web_hook"
-                           "address" (quri:render-uri
-                                      (quri:merge-uris (quri:uri (format nil "/hook/~A" webhook))
-                                                       (quri:uri *web-path*))))
+                           "address" (get-webhook-url webhook))
                      (when token (list "token" token))
                      (when expiration (list "expiration" expiration))
                      (when payload (list "payload" "true"))

plugins/huiza.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.huiza
+  (:use :cl :chatikbot.common :chatikbot.eliza))
+(in-package :chatikbot.plugins.huiza)
 
 (defparameter *fuck-off*
   '((отъебись) (мне похуй) (ебаный ты нахуй!))
@@ -44,8 +47,8 @@
      (:sticker . "BQADBAADQAEAAnscSQABqWydSKTnASoC"))))
 
 (defun send-dont-understand (chat-id &optional text reply-id)
-  (let ((resp (eliza text *huiza-rules*)))
-    (log:info text resp)
+  (let* ((*package* (find-package :chatikbot.plugins.huiza))
+         (resp (eliza (read-from-string-no-punct text) *huiza-rules*)))
     (when resp
       (send-response chat-id resp reply-id))))
 

plugins/ledger.lisp

@@ -1,24 +1,34 @@
-(in-package #:chatikbot)
-(ql:quickload :pta-ledger)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.ledger
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.ledger)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :pta-ledger))
 
 (defsetting *ledger/default-timezone* -3 "Default timezone for time display. GMT+3")
 (defvar *ledger/chat-journals* (make-hash-table))
 
 (defun ledger/get-hook-url (chat-id url)
   (declare (ignore url))
-  (get-webhook-url "ledger" chat-id (token-hmac (format nil "~A" chat-id))))
+  (get-webhook-url "ledger" chat-id (token-hmac (write-to-string chat-id))))
 
 (defun ledger/parse-uri (chat-id uri)
   (setf (gethash chat-id *ledger/chat-journals*)
         (cons (pta-ledger:parse-journal (http-request uri))
               (get-universal-time))))
 
+(defun ledger/format-uri (url)
+  (let ((uri (quri:uri url)))
+    (quri:render-uri (quri:make-uri :userinfo (when (quri:uri-userinfo uri) "*:*")
+                                    :defaults url))))
+
 (defun ledger/handle-set-uri (chat-id uri)
   (handler-case
       (destructuring-bind (journal . ut)
           (ledger/parse-uri chat-id uri)
         (declare (ignore ut))
-        (secret/set (list :ledger chat-id) uri)
+        (secret-set (list :ledger chat-id) uri)
         (send-response chat-id (format nil "Добавил журнал с ~D записями. Веб-хук для обновления: ~A"
                                        (length journal)
                                        (ledger/get-hook-url chat-id uri))))
@@ -36,15 +46,14 @@
               year month day hour min sec))))
 
 (defun ledger/handle-info (chat-id)
-  (secret/with (uri (list :ledger chat-id))
+  (with-secret (uri (list :ledger chat-id))
     (if uri
         (destructuring-bind (journal . ut)
             (or (gethash chat-id *ledger/chat-journals*)
                 (ledger/parse-uri chat-id uri))
           (bot-send-message chat-id (format nil "Журнал с ~D записями, из ~A, обновлён ~A.~%Веб-хук: ~A"
                                             (length journal)
-                                            (quri:render-uri (quri:make-uri :userinfo nil
-                                                                            :defaults uri))
+                                            (ledger/format-uri uri)
                                             (ledger/format-time ut)
                                             (ledger/get-hook-url chat-id uri))
                             :disable-web-preview t))
@@ -56,14 +65,14 @@
     (:otherwise (ledger/handle-info chat-id))))
 
 (defun ledger/handle-balance (chat-id query)
-  (destructuring-bind (journal . ut)
-      (gethash chat-id *ledger/chat-journals*)
-    (if journal
-        (bot-send-message chat-id (format nil "```~%~A~%```Обновлено: ~A"
-                                          (pta-ledger:journal-balance journal query)
-                                          (ledger/format-time ut))
-                          :parse-mode "markdown")
-        (secret/with (uri (list :ledger chat-id))
+  (let ((pair (gethash chat-id *ledger/chat-journals*)))
+    (if pair
+        (destructuring-bind (journal . ut) pair
+          (bot-send-message chat-id (format nil "```~%~A~%```Обновлено: ~A"
+                                            (pta-ledger:journal-balance journal query)
+                                            (ledger/format-time ut))
+                            :parse-mode "markdown"))
+        (with-secret (uri (list :ledger chat-id))
           (if uri
               (progn (ledger/parse-uri chat-id uri)
                      (ledger/handle-balance chat-id query))
@@ -79,6 +88,6 @@
     (destructuring-bind (chat-id hmac) paths
       (let ((true-hmac (token-hmac chat-id)))
         (when (string= true-hmac hmac)
-          (secret/with (uri (list :ledger chat-id))
+          (with-secret (uri (list :ledger chat-id))
             (when uri
               (ledger/parse-uri (parse-integer chat-id) uri))))))))

plugins/nalunch.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.nalunch
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.nalunch)
 
 (defvar *nalunch/calend* nil "Working calendar exceptions")
 
@@ -49,10 +52,10 @@
              (balance (parse-integer (plump:text (elt (clss:select ".newswire-header_balance" dom) 0))))
              (recent (loop for day across (clss:select ".day-feed" dom)
                         append (loop for el across (clss:select ".media" day)
-                                  for date = (select-text ".day-feed_date" day)
-                                  for time = (select-text ".transaction_time" el)
-                                  for price = (parse-integer (select-text ".transaction_price" el))
-                                  for place = (select-text ".transaction-title" el)
+                                  for date = (select-text day ".day-feed_date")
+                                  for time = (select-text el ".transaction_time")
+                                  for price = (parse-integer (select-text el ".transaction_price"))
+                                  for place = (select-text el ".transaction-title")
                                   collect (list (cons :time (format nil "~A ~A" date time))
                                                 (cons :price price)
                                                 (cons :place place))))))
@@ -98,7 +101,7 @@
 (defvar *nalunch/jars* (make-hash-table) "Cookie jars")
 (defcron process-nalunch (:minute '(member 0 10 20 30 40 50))
   (dolist (chat-id (lists-get :nalunch))
-    (secret/with (login-pass (list :nalunch chat-id))
+    (with-secret (login-pass (list :nalunch chat-id))
       (if login-pass
           (let* ((cookie-jar (or (gethash chat-id *nalunch/jars*)
                                  (cl-cookie:make-cookie-jar)))
@@ -111,19 +114,9 @@
               (setf (gethash chat-id *nalunch/last-results*) new
                     (gethash chat-id *nalunch/jars*) cookie-jar)))
           (progn
-            (log:warn "nalunch no login/pass for" chat-id)
-;;            (lists-set-entry :nalunch chat-id nil)  ;; Comment out for now
-            )))))
+            (log:warn "nalunch no login/pass for" chat-id))))))
 
 ;; Hooks
-(def-message-cmd-handler handle-cmd-nalunch (:nalunch)
-  (if (member chat-id *admins*)
-      (send-response chat-id (nalunch-format
-                              (or *nalunch-last-result*
-                                  (setf *nalunch-last-result*
-                                        (nalunch-recent)))))
-      (send-dont-understand chat-id)))
-
 (defun nalunch/handle-set-cron (chat-id enable)
   (lists-set-entry :nalunch chat-id enable)
   (bot-send-message chat-id
@@ -136,12 +129,12 @@
     (handler-case
         (progn
           (nalunch/auth login pass cookies)
-          (secret/set `(:nalunch ,chat-id) (cons login pass))
+          (secret-set `(:nalunch ,chat-id) (cons login pass))
           (nalunch/handle-set-cron chat-id t))
       (error () (bot-send-message chat-id "Чот не смог, пропробуй другие.")))))
 
 (defun nalunch/handle-recent (chat-id)
-  (secret/with (login-pass (list :nalunch chat-id))
+  (with-secret (login-pass (list :nalunch chat-id))
     (bot-send-message chat-id
                       (if login-pass
                           (let* ((cookies (or (gethash chat-id *nalunch/jars*)

plugins/rss.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.rss
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.rss)
 
 (defstruct feed id url title next-fetch (period 300))
 (defstruct feed-item feed guid link title description published)
@@ -46,30 +49,6 @@
           (feed-next-fetch feed) (local-time:timestamp+ (local-time:now) new-period :sec))
     items))
 
-(defun trim-nil (text)
-  (when text
-    (let ((text (string-trim " " text)))
-      (unless (zerop (length text))
-        text))))
-
-(defun text-with-cdata (node)
-  "Compiles all text nodes within the nesting-node into one string."
-  (with-output-to-string (stream)
-    (labels ((r (node)
-               (loop for child across (plump:children node)
-                  do (typecase child
-                       (plump:text-node (write-string (plump:text child) stream))
-                       (plump:cdata (write-string (plump:text child) stream))
-                       (plump:nesting-node (r child))))))
-      (r node))))
-
-(defun child-text (node tag)
-  (alexandria:when-let (child (car (get-by-tag node tag)))
-    (trim-nil (text-with-cdata child))))
-
-(defun clean-text (text)
-  (when text (trim-nil (plump:text (plump:parse text)))))
-
 (defun %send-feeds (chat-id feeds)
   (bot-send-message chat-id
                     (if (null feeds)

plugins/saver.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.saver
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.saver)
 
 (defsetting *saver-default-timezone* -3 "Default timezone for *saver-notify-hour* calculation. GMT+3")
 (defsetting *saver-notify-hour* 11 "Notify with upcoming payments and saves at this time")

plugins/transmission.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.transmission
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.transmission)
 
 (defsetting *transmission-settings* nil "ALIST of (chat-id . url)")
 (defsetting *transmission-locations* nil "ALIST of (name . location)")
@@ -15,8 +18,8 @@
 
 (defun transmission-set-session (url session-id)
   (setf *transmission-sessions*
-	(cons (cons url session-id)
-	      (remove url *transmission-sessions* :test #'equal :key #'car))))
+    (cons (cons url session-id)
+          (remove url *transmission-sessions* :test #'equal :key #'car))))
 
 (defun transmission-request (url method &rest arguments)
   (let ((retries (getf arguments :retries 0)))
@@ -24,25 +27,25 @@
       (error "Too many retries"))
     (remf arguments :retries)
     (let ((session-id (aget url *transmission-sessions*))
-	  (content
-	   (with-output-to-string (stream)
-	     (yason:encode (alexandria:plist-hash-table
-			    (list "method" (dekeyify method t)
-				  "arguments" (alexandria:plist-hash-table
-					       (loop for (key value) on arguments by #'cddr
-						  when value
-						  appending (list (dekeyify key) value)))))
-			   stream))))
+      (content
+       (with-output-to-string (stream)
+         (yason:encode (alexandria:plist-hash-table
+                (list "method" (dekeyify method t)
+                  "arguments" (alexandria:plist-hash-table
+                           (loop for (key value) on arguments by #'cddr
+                          when value
+                          appending (list (dekeyify key) value)))))
+               stream))))
       (handler-case
-	  (let* ((response (json-request url :method :post :content content
-					 :headers (list (cons :x-transmission-session-id session-id))))
-		 (result (aget "result" response)))
-	    (unless (equal "success" result)
-	      (error result))
-	    (aget "arguments" response))
-	(dex:http-request-conflict (e)
-	  (transmission-set-session url (gethash "x-transmission-session-id" (dex:response-headers e)))
-	  (apply #'transmission-request url method :retries (1+ retries) arguments))))))
+      (let* ((response (json-request url :method :post :content content
+                     :headers (list (cons :x-transmission-session-id session-id))))
+         (result (aget "result" response)))
+        (unless (equal "success" result)
+          (error result))
+        (aget "arguments" response))
+    (dex:http-request-conflict (e)
+      (transmission-set-session url (gethash "x-transmission-session-id" (dex:response-headers e)))
+      (apply #'transmission-request url method :retries (1+ retries) arguments))))))
 
 (defun transmission-get-torrents (url &optional ids (fields '("id" "name" "status" "percentDone" "eta" "totalSize")))
   (aget "torrents" (transmission-request url :torrent-get :ids ids :fields fields)))

plugins/tumblr.lisp

@@ -1,4 +1,7 @@
-(in-package :chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.tumblr
+  (:use :cl :chatikbot.common :chatikbot.eliza))
+(in-package :chatikbot.plugins.tumblr)
 
 (defvar *tumblr-roll* nil "List of tumblr to select from")
 (defparameter *read-timeout* 5 "API request timeout")
@@ -53,6 +56,8 @@
   (tumblr-random-post :roll roll :type :photo :num num))
 
 (def-message-handler handle-tumblr (message)
-  (alexandria:when-let ((resp (eliza (preprocess-input text) *tumblr-rules*)))
-    (log:info resp)
-    (send-response chat-id resp)))
+  (let* ((*package* (find-package :chatikbot.plugins.tumblr))
+         (resp (eliza (read-from-string-no-punct text) *tumblr-rules*)))
+    (when resp
+      (log:info resp)
+      (send-response chat-id resp))))

plugins/twitter.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.twitter
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.twitter)
 
 (defsetting *twitter-access-token* nil "OAuth access token")
 

plugins/udmx.lisp

@@ -0,0 +1,68 @@
+(in-package #:chatikbot)
+
+(defparameter +udmx-vendor-id+ #x16C0 "VOTI")
+(defparameter +udmx-product-id+ #x05DC "Obdev's free shared PID")
+
+(defparameter +udmx-req-set-single-channel+ 1 "usb request for cmd_SetSingleChannel:
+        bmRequestType:	ignored by device, should be USB_TYPE_VENDOR | USB_RECIP_DEVICE | USB_ENDPOINT_OUT
+        bRequest:		cmd_SetSingleChannel
+        wValue:			value of channel to set [0 .. 255]
+        wIndex:			channel index to set [0 .. 511]
+        wLength:		ignored")
+
+(defparameter +udmx-req-set-channel-range+ 2 "usb request for cmd_SetChannelRange:
+              bmRequestType:	ignored by device, should be USB_TYPE_VENDOR | USB_RECIP_DEVICE | USB_ENDPOINT_OUT
+              bRequest:		cmd_SetChannelRange
+              wValue:			number of channels to set [1 .. 512-wIndex]
+              wIndex:			index of first channel to set [0 .. 511]
+              wLength:		length of data, must be >= wValue")
+
+(defparameter +udmx-req-start-bootloader+ #xf8 "Start Bootloader for Software updates")
+
+(defparameter +udmx-err-bad-channel+ 1)
+(defparameter +udmx-err-bad-value+ 2)
+
+(defparameter +udmx-timeout+ 5000)
+
+(defparameter +udmx-manufacturer+ "www.anyma.ch")
+(defparameter +udmx-product+ "uDMX")
+
+(defun udmx-find-device ()
+  (loop for device in (cl-libusb:usb-get-devices-by-ids +udmx-vendor-id+ +udmx-product-id+)
+     do (unwind-protect
+             (progn
+               (cl-libusb:usb-open device)
+               (when (and (equal (cl-libusb:usb-get-string device :manufacturer) +udmx-manufacturer+)
+                          (equal (cl-libusb:usb-get-string device :product) +udmx-product+))
+                 (return device)))
+          (when (cl-libusb:usb-open-p device)
+            (cl-libusb:usb-close device)))))
+
+(defparameter +udmx-request-type+
+  (logior (cffi:foreign-enum-value 'libusb-ffi::type :vendor)
+          (cffi:foreign-enum-value 'libusb-ffi::recip :device)
+          (cffi:foreign-enum-value 'libusb-ffi::endpoint :out)))
+
+(defun %udmx-set-single-channel (device channel value)
+  (declare (type (integer 0 511) channel)
+           (type (integer 0 255) value))
+  (static-vectors:with-static-vector (buffer 1)
+    (cl-libusb:usb-control-msg device +udmx-request-type+ +udmx-req-set-single-channel+
+                               value channel buffer +udmx-timeout+)))
+
+(defun %udmx-set-channel-range (device first-channel values)
+  (declare (type (integer 0 511) first-channel))
+  (static-vectors:with-static-vector (buffer (length values) :initial-contents values)
+    (cl-libusb:usb-control-msg device +udmx-request-type+ +udmx-req-set-channel-range+
+                               (length buffer) first-channel buffer +udmx-timeout+)))
+
+(defun udmx-set-channel (device channel value &rest more-values)
+  (unless (cl-libusb:usb-open-p device)
+    (cl-libusb:usb-open device))
+  (loop for retries from 0 to 100
+     do (ignore-errors
+          (return (values (if (consp more-values)
+                              (%udmx-set-channel-range device channel (cons value more-values))
+                              (%udmx-set-single-channel device channel value))
+                          retries)))
+     finally (return (values nil retries))))

plugins/vk.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.vk
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.vk)
 
 (defparameter +vk-api-ver+ "5.53" "vk api version to use")
 (defparameter +vk-api-url+ "https://api.vk.com/method/~A?v=~A" "vk.com API endpoint")
@@ -14,8 +17,8 @@
 
 (defun vk-get-authorization-url (&optional state &rest scopes)
   (let ((scope (apply #'+ (mapcar #'(lambda (k) (cdr (assoc k +vk-scope-mapping+))) scopes))))
-    (format nil "~A?v=~A&client_id=~A&redirect_uri=~A/oauth~@[&scope=~A~]~@[&state=~A~]"
-            +vk-oauth-authorize+ +vk-api-ver+ *vk-app-client-id* *web-path* (unless (zerop scope) scope) state)))
+    (format nil "~A?v=~A&client_id=~A&redirect_uri=~A~@[&scope=~A~]~@[&state=~A~]"
+            +vk-oauth-authorize+ +vk-api-ver+ *vk-app-client-id* (get-oauth-url) (unless (zerop scope) scope) state)))
 
 (defun %vk-api-call (method &optional args)
   (let* ((params (loop for (k . v) in args
@@ -31,6 +34,38 @@
       (error (aget "error_msg" (aget "error" response))))
     (aget "response" response)))
 
+;; Database
+(def-db-init
+  (db-execute "create table if not exists vk_walls (domain, last_id, next_fetch, period)")
+  (db-execute "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)")
+
+  (db-execute "create table if not exists vk_chat_walls (chat_id, domain)")
+  (db-execute "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)")
+  (db-execute "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)"))
+
+(defun db/vk-ensure-domain (domain last-id)
+  (db-transaction
+    (unless (db-single "select domain from vk_walls where domain = ?" domain)
+      (db-execute "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id))))
+
+(defun db/vk-get-domain-chats (domain)
+  (flatten (db-select "select chat_id from vk_chat_walls where domain = ?" domain)))
+
+(defun db/vk-get-chat-domains (chat-id)
+  (flatten (db-select "select domain from vk_chat_walls where chat_id  = ?" chat-id)))
+
+(defun db/vk-add-chat-domain (chat-id domain)
+  (db-execute "insert into vk_chat_walls (chat_id, domain) values (?, ?)" chat-id domain))
+
+(defun db/vk-remove-chat-domain (chat-id domain)
+  (db-execute "delete from vk_chat_walls where chat_id = ? and domain = ?" chat-id domain))
+
+(defun db/vk-get-active-walls ()
+  (db-select "select domain, last_id, next_fetch, period from vk_walls w where exists (select 1 from vk_chat_walls where domain=w.domain)"))
+
+(defun db/vk-update-wall (domain last-id next-fetch period)
+  (db-execute "update vk_walls set last_id = ?, next_fetch = ?, period = ? where domain = ?" last-id next-fetch period domain))
+
 (defun vk-wall-get (&key owner-id domain offset count filter extended fields)
   (%vk-api-call "wall.get"
                 `(("owner_id" . ,owner-id)
@@ -136,38 +171,6 @@
              text)
      (if preview 0 1))))
 
-;; Database
-(def-db-init
-  (db-execute "create table if not exists vk_walls (domain, last_id, next_fetch, period)")
-  (db-execute "create unique index if not exists vk_walls_domain_idx on vk_walls (domain)")
-
-  (db-execute "create table if not exists vk_chat_walls (chat_id, domain)")
-  (db-execute "create index if not exists vk_chat_walls_chat_idx on vk_chat_walls (chat_id)")
-  (db-execute "create index if not exists vk_chat_walls_domain_idx on vk_chat_walls (domain)"))
-
-(defun db/vk-ensure-domain (domain last-id)
-  (db-transaction
-    (unless (db-single "select domain from vk_walls where domain = ?" domain)
-      (db-execute "insert into vk_walls (domain, last_id, period) values (?, ?, 300)" domain last-id))))
-
-(defun db/vk-get-domain-chats (domain)
-  (flatten (db-select "select chat_id from vk_chat_walls where domain = ?" domain)))
-
-(defun db/vk-get-chat-domains (chat-id)
-  (flatten (db-select "select domain from vk_chat_walls where chat_id  = ?" chat-id)))
-
-(defun db/vk-add-chat-domain (chat-id domain)
-  (db-execute "insert into vk_chat_walls (chat_id, domain) values (?, ?)" chat-id domain))
-
-(defun db/vk-remove-chat-domain (chat-id domain)
-  (db-execute "delete from vk_chat_walls where chat_id = ? and domain = ?" chat-id domain))
-
-(defun db/vk-get-active-walls ()
-  (db-select "select domain, last_id, next_fetch, period from vk_walls w where exists (select 1 from vk_chat_walls where domain=w.domain)"))
-
-(defun db/vk-update-wall (domain last-id next-fetch period)
-  (db-execute "update vk_walls set last_id = ?, next_fetch = ?, period = ? where domain = ?" last-id next-fetch period domain))
-
 ;; Cron
 (defcron process-walls ()
   (loop for (domain last-id next-fetch period) in (db/vk-get-active-walls)
@@ -180,7 +183,7 @@
                      (remove last-id (reverse (aget "items" (vk-wall-get :domain domain)))
                              :test #'>= :key (lambda (p) (aget "id" p))))
                     name)
-                (setf period (adjust-period period (length new-posts)))
+                (setf period (chatikbot.plugins.rss::adjust-period period (length new-posts)))
                 (when new-posts
                   (setf name (vk-get-name domain)))
                 (dolist (post new-posts)

plugins/yit.lisp

@@ -0,0 +1,30 @@
+(in-package :cl-user)
+(defpackage chatikbot.plugins.yit
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.yit)
+
+(defun yit-info ()
+  (labels ((get-rows (url)
+             (rest (get-by-tag (plump:get-element-by-id (xml-request url) "apartmentList") "tr")))
+           (row-data (row)
+             (mapcar (lambda (e) (string-trim '(#\Newline #\Space) (plump:text e)))
+                     (get-by-tag row "td")))
+           (format-data (data)
+             (format nil "~{~A~^ ~}" (mapcar (lambda (n) (nth n data)) '(1 2 3 4 7 6))))
+           (get-intresting (rows)
+             (loop for row in rows
+                for data = (row-data row)
+                for rooms = (parse-integer (nth 2 data))
+                for area = (parse-float:parse-float (replace-all (nth 3 data) "," "."))
+                when (= rooms 3)
+                when (< 65 area 75)
+                collect data))
+           (format-apts (url)
+             (let ((apts (get-intresting (get-rows url))))
+               (format nil "~A~%~{~A~^~%~}~%~A/~A" url (mapcar #'format-data apts)
+                       (length (remove "забронировано" apts :test #'equal :key #'(lambda (r) (nth 7 r)) ))
+                       (length apts)))))
+    (format nil "~{~A~^~%~%~}"
+            (mapcar #'format-apts
+                    '("http://www.yitspb.ru/yit_spb/catalog/apartments/novoorlovskiy-korpus-1-1-1"
+                      "http://www.yitspb.ru/yit_spb/catalog/apartments/novoorlovskiy-korpus-1-1-2")))))

plugins/zhanna.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.zhanna
+  (:use :cl :chatikbot.common :chatikbot.gsheets))
+(in-package :chatikbot.plugins.zhanna)
 
 (defsetting *zhanna-token-id* nil)
 (defsetting *zhanna-sheet-id* "1kLBodFUwcfbpdqe_d2d01MHij95NAVcKrmpjotYsUQk")

plugins/zsd.lisp

@@ -1,4 +1,7 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.plugins.zsd
+  (:use :cl :chatikbot.common))
+(in-package :chatikbot.plugins.zsd)
 
 (defparameter +zsd-api-url+ "https://mcabinet.nch-spb.com/onyma/system/api/json")
 (defparameter +zsd-auth-url+ "https://mcabinet.nch-spb.com/onyma/system/api/jsonex?function=open_session")
@@ -53,7 +56,7 @@
     (when wall-diff
       (format nil "ЗСД остаток: *~$р.*~%~%~{~A~^~%~}"
               (parse-float (aget "remainder" (car (aget "contract" new))))
-              (loop for item in (reverse wall-diff)
+              (loop for item in wall-diff
                  collect (%zsd/format-wall item (aget "pan" new)))))))
 
 (defun zsd/handle-set-cron (chat-id enable)
@@ -67,12 +70,12 @@
   (let ((token (zsd/auth login pass)))
     (if token
         (progn
-          (secret/set `(:zsd ,chat-id) token)
+          (secret-set `(:zsd ,chat-id) token)
           (zsd/handle-set-cron chat-id t))
         (bot-send-message chat-id "Чот не смог, пропробуй другие."))))
 
 (defun zsd/handle-recent (chat-id)
-  (secret/with (token (list :zsd chat-id))
+  (with-secret (token (list :zsd chat-id))
     (bot-send-message chat-id
                       (if token
                           (let ((data (zsd/load-data token)))
@@ -92,7 +95,7 @@
 (defvar *zsd/last-results* (make-hash-table) "Last check results")
 (defcron process-zsd (:minute '(member 0 10 20 30 40 50))
   (dolist (chat-id (lists-get :zsd))
-    (secret/with (token (list :zsd chat-id))
+    (with-secret (token (list :zsd chat-id))
       (if token
           (let ((old (gethash chat-id *zsd/last-results*))
                 (new (zsd/load-data token)))
@@ -102,6 +105,4 @@
                   (bot-send-message chat-id changes :parse-mode "markdown")))
               (setf (gethash chat-id *zsd/last-results*) new)))
           (progn
-            (log:warn "zsd no token for" chat-id)
-            ;;(lists-set-entry :zsd chat-id nil)
-            )))))
+            (log:warn "zsd no token for" chat-id))))))

secrets.lisp

@@ -1,10 +1,21 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.secrets
+  (:use :cl)
+  (:export :*secret-ring*
+           :*secret-pass-store*
+           :*secret-pass-bin*
+           :secret-get
+           :secret-set
+           :secret-del
+           :secret-wipe
+           :with-secret))
+(in-package :chatikbot.secrets)
 
 (defvar *secret-ring* nil "GPG keyring path")
 (defvar *secret-pass-store* nil "pass store dir")
 (defvar *secret-pass-bin* "pass" "pass util binary")
 
-(defun %secret/pass (cmd path &key input (output :string) error-output)
+(defun pass (cmd path &key input (output :string) error-output)
   (let ((input-stream (when input (make-string-input-stream input))))
     (unwind-protect
          (uiop:run-program
@@ -15,29 +26,29 @@
       (when input-stream
         (close input-stream)))))
 
-(defun secret/get (path)
+(defun secret-get (path)
   (handler-case
       (let ((*read-eval* nil))
-        (values (read-from-string (%secret/pass "show" path))))
+        (values (read-from-string (pass "show" path))))
     (error () (values))))
 
-(defun secret/set (path value)
-  (%secret/pass "insert --force --multiline" path
-                :input (prin1-to-string value) :output nil :error-output :string))
+(defun secret-set (path value)
+  (pass "insert --force --multiline" path
+        :input (prin1-to-string value) :output nil :error-output :string))
 
-(defun secret/del (path)
-  (%secret/pass "rm --force" path))
+(defun secret-del (path)
+  (pass "rm --force" path))
 
-(defun secret/wipe (data)
+(defun secret-wipe (data)
   (cond
     ((stringp data) (fill data #\Space))
     ((vectorp data) (fill data 0))
     ((consp data)
-     (secret/wipe (car data))
-     (secret/wipe (cdr data)))))
+     (secret-wipe (car data))
+     (secret-wipe (cdr data)))))
 
-(defmacro secret/with ((var path) &body body)
-  `(let ((,var (ignore-errors (secret/get ,path))))
+(defmacro with-secret ((var path) &body body)
+  `(let ((,var (ignore-errors (secret-get ,path))))
      (unwind-protect
           (progn ,@body)
-       (secret/wipe ,var))))
+       (secret-wipe ,var))))

server.lisp

@@ -1,4 +1,14 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.server
+  (:use :cl :chatikbot.utils)
+  (:import-from :chatikbot.bot
+                :handle-update)
+  (:import-from :chatikbot.telegram
+                :*telegram-token*)
+  (:export :def-webhook-handler
+           :get-webhook-url
+           :get-oauth-url))
+(in-package :chatikbot.server)
 
 (defvar *web-path* nil "Set to externally accessible url")
 (defvar *web-iface* nil "Interface to listen on")
@@ -29,6 +39,11 @@
     (error (e) (log:error e)))
   "OK")
 
+(defun get-oauth-url ()
+  (quri:render-uri
+   (quri:merge-uris (quri:uri "/oauth")
+                    (quri:uri *web-path*))))
+
 (hunchentoot:define-easy-handler (oauth-handler :uri "/oauth") (code error state)
   (handler-case
       (run-hooks :oauth code error state)

telegram.lisp

@@ -1,4 +1,36 @@
-(in-package #:chatikbot)
+(in-package :cl-user)
+(defpackage chatikbot.telegram
+  (:use :cl :chatikbot.utils)
+  (:export :*telegram-token*
+           :+telegram-max-callback-data-length+
+           :telegram-get-updates
+           :telegram-get-me
+           :telegram-set-webhook
+           :telegram-send-message
+           :telegram-forward-message
+           :telegram-send-photo
+           :telegram-send-audio
+           :telegram-send-document
+           :telegram-send-sticker
+           :telegram-send-video
+           :telegram-send-voice
+           :telegram-send-location
+           :telegram-send-chat-action
+           :telegram-send-get-user-profile-photos
+           :telegram-send-get-file
+           :telegram-answer-callback-query
+           :telegram-edit-message-text
+           :telegram-edit-message-caption
+           :telegram-edit-message-reply-markup
+           :telegram-answer-inline-query
+           :telegram-file-contents
+           :telegram-inline-keyboard-markup
+           :telegram-reply-keyboard-markup
+           :telegram-reply-keyboard-hide
+           :telegram-force-reply
+           :send-response
+           :bot-send-message))
+(in-package :chatikbot.telegram)
 
 (defvar *telegram-token* nil "Telegram bot token")
 (defparameter +telegram-api-format+ "https://api.telegram.org/bot~A/~A")

utils.lisp

@@ -1,7 +1,72 @@
-(in-package #:chatikbot)
-
+(in-package :cl-user)
+(defpackage chatikbot.utils
+  (:use :cl)
+  (:export :*admins*
+           :*bot-name*
+           :*hooks*
+           :run-hooks
+           :add-hook
+           :remove-hook
+           :keyify
+           :dekeyify
+           :*settings*
+           :defsetting
+           :*backoff-start*
+           :*backoff-max*
+           :loop-with-error-backoff
+           :replace-all
+           :aget
+           :agets
+           :mappend
+           :random-elt
+           :flatten
+           :preprocess-input
+           :punctuation-p
+           :read-from-string-no-punct
+           :print-with-spaces
+           :spaced
+           :http-request
+           :xml-request
+           :get-by-tag
+           :select-text
+           :trim-nil
+           :text-with-cdata
+           :child-text
+           :clean-text
+           :json-request
+           :plist-hash
+           :plist-json
+           :format-ts
+           :parse-cmd
+           :parse-float
+           :smart-f
+           :format-size
+           :format-interval
+           :symbol-append
+           :message-id
+           :from-id
+           :chat-id
+           :text
+           :cmd
+           :args
+           :query-id
+           :from
+           :raw-data
+           :message
+           :data
+           :section
+           :code
+           :error
+           :raw-state
+           :state
+           :inline-message-id
+           :hook
+           :headers
+           :paths))
+(in-package #:chatikbot.utils)
+
+(defvar *admins* nil "Admins chat-ids")
 (defvar *bot-name* nil "bot name to properly handle text input")
-
 (defvar *hooks* (make-hash-table) "Hooks storage")
 
 (defun run-hooks (event &rest arguments)
@@ -101,42 +166,9 @@ is replaced with replacement."
           (preprocess-input (subseq text (1+ first-space)))
           (replace-all text *bot-name* "ты")))))
 
-(defun punctuation-p (char)
-  (find char ".,;:'!?#-()\\\""))
-
-(defun read-from-string-no-punct (input)
-  "Read from an input string, ignoring punctuation."
-  (let ((*package* (find-package 'chatikbot)))
-    (read-from-string
-     (concatenate 'string "(" (substitute-if #\space #'punctuation-p input) ")"))))
-
 (defun print-with-spaces (list)
   (format nil "~@(~{~a~^ ~}~)" list))
 
-(defun switch-viewpoint (words)
-  "Change I to you and vice versa, and so on."
-  (sublis '((I . you) (you . I) (me . you) (am . are)
-            (я ты) (ты я) (меня тебя) (тебя меня))
-          words))
-
-(defun use-eliza-rules (input rules)
-  "Find some rule with which to transform the input."
-  (rule-based-translator input rules
-                         :action #'(lambda (bindings responses)
-                                     (sublis (switch-viewpoint bindings)
-                                             (random-elt responses)))))
-
-(defun eliza (input rules)
-  (let ((r (use-eliza-rules
-            (read-from-string-no-punct input)
-            rules)))
-    (cond
-      ((null r) nil)
-      ((and (consp (car r)) (eq 'function (caar r)))
-       (apply (cadar r) (cdr r)))
-      ((keywordp (car r)) r)
-      (t (print-with-spaces (flatten r))))))
-
 (defun parse-cmd (text)
   (let* ((args (split-sequence:split-sequence #\Space (subseq text 1) :remove-empty-subseqs t))
          (cmd (subseq (car args) 0 (position #\@ (car args)))))
@@ -217,13 +249,36 @@ is replaced with replacement."
 (defun get-by-tag (node tag)
   (nreverse (org.shirakumo.plump.dom::get-elements-by-tag-name node tag)))
 
-(defun select-text (selector node)
+(defun select-text (node &optional selector)
   (ignore-errors
-    (plump:text (plump:strip
-                 (let ((node (elt (clss:select selector node) 0)))
-                   (plump:traverse node #'(lambda (n) (setf (plump:text n) ""))
-                                   :test #'plump:comment-p)
-                   node)))))
+    (when selector (setf node (elt (clss:select selector node) 0)))
+    (plump:traverse node #'(lambda (n) (setf (plump:text n) ""))
+                    :test #'plump:comment-p)
+    (plump:text (plump:strip node))))
+
+(defun trim-nil (text)
+  (when text
+    (let ((text (string-trim " " text)))
+      (unless (zerop (length text))
+        text))))
+
+(defun text-with-cdata (node)
+  "Compiles all text nodes within the nesting-node into one string."
+  (with-output-to-string (stream)
+    (labels ((r (node)
+               (loop for child across (plump:children node)
+                  do (typecase child
+                       (plump:text-node (write-string (plump:text child) stream))
+                       (plump:cdata (write-string (plump:text child) stream))
+                       (plump:nesting-node (r child))))))
+      (r node))))
+
+(defun child-text (node tag)
+  (alexandria:when-let (child (car (get-by-tag node tag)))
+    (trim-nil (text-with-cdata child))))
+
+(defun clean-text (text)
+  (when text (trim-nil (plump:text (plump:parse text)))))
 
 ;; JSON processing
 (defun json-request (url &rest args &key method parameters content headers basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent (object-as :alist))
@@ -298,151 +353,10 @@ is replaced with replacement."
     ((< seconds (* 60 60 24 7 54)) (format nil "~A weeks" (round seconds (* 60 60 24 7))))
     (:otherwise (format nil "~A years" (smart-f (/ seconds (* 60 60 24 365.25)) 1)))))
 
-(defun token-hmac (message &optional (hmac-length 12))
-  (let ((hmac (crypto:make-hmac (crypto:ascii-string-to-byte-array *telegram-token*) :sha256)))
-    (crypto:update-hmac hmac (crypto:ascii-string-to-byte-array message))
-    (base64:usb8-array-to-base64-string
-     (subseq (crypto:hmac-digest hmac) 0 hmac-length) :uri t)))
-
-(defun encode-callback-data (chat-id section data &optional (ttl 600) (hmac-length 12))
-  (when (find #\: data)
-    (error "Bad data."))
-  (let* ((message (format nil "~A:~A:~A:~A"
-                          (base64:integer-to-base64-string chat-id)
-                          (base64:integer-to-base64-string
-                           (+ ttl (local-time:timestamp-to-universal (local-time:now))))
-                          section data))
-         (encoded (format nil "~A$~A" message (token-hmac message hmac-length))))
-    (when (> (length encoded) +telegram-max-callback-data-length+)
-      (error "Max callback length exceeded"))
-    encoded))
-
-(defun decode-callback-data (chat-id raw-data &optional (hmac-length 12))
-  (destructuring-bind (message hmac)
-      (split-sequence:split-sequence #\$ raw-data :from-end t :count 2)
-    (destructuring-bind (cid expire section data)
-        (split-sequence:split-sequence #\: message :count 4)
-      (unless (= chat-id (base64:base64-string-to-integer cid))
-        (error "Wrong chat id."))
-      (unless (>= (base64:base64-string-to-integer expire)
-                  (local-time:timestamp-to-universal (local-time:now)))
-        (error "Expired."))
-      (unless (equal hmac (token-hmac message hmac-length))
-        (error "Bad data."))
-      (values data (intern (string-upcase section) "KEYWORD")))))
-
-(defmacro def-message-handler (name (message) &body body)
-  `(progn
-     (defun ,name (,message)
-       (let ((message-id (aget "message_id" ,message))
-             (from-id (aget "id" (aget "from" ,message)))
-             (chat-id (aget "id" (aget "chat" ,message)))
-             (text (aget "text" ,message)))
-         (declare (ignorable message-id from-id chat-id text))
-         (handler-case (progn ,@body)
-           (error (e)
-             (log:error "~A" e)
-             (bot-send-message chat-id
-                               (format nil "Ошибочка вышла~@[: ~A~]"
-                                       (when (member chat-id *admins*) e)))))))
-     (add-hook :update-message ',name)))
-
-(defmacro def-message-cmd-handler (name (&rest commands) &body body)
-  `(def-message-handler ,name (message)
-     (when (and text (equal #\/ (char text 0)))
-       (multiple-value-bind (cmd args) (parse-cmd text)
-         (when (member cmd (list ,@commands))
-           (log:info cmd message-id chat-id from-id args)
-           ,@body
-           t)))))
-
-(defmacro def-message-admin-cmd-handler (name (&rest commands) &body body)
-  `(def-message-handler ,name (message)
-     (when (and (member chat-id *admins*)
-                text (equal #\/ (char text 0)))
-       (multiple-value-bind (cmd args) (parse-cmd text)
-         (when (member cmd (list ,@commands))
-           (log:info cmd message-id chat-id from-id args)
-           ,@body
-           t)))))
-
-(defmacro def-callback-handler (name (callback) &body body)
-  `(progn
-     (defun ,name (,callback)
-       (let* ((query-id (aget "id" ,callback))
-              (from (aget "from" ,callback))
-              (raw-data (aget "data" ,callback))
-              (message (aget "message" ,callback))
-              (inline-message-id (aget "inline_message_id" ,callback))
-              (from-id (aget "id" from))
-              (chat-id (aget "id" (aget "chat" message)))
-              (message-id (aget "message_id" message)))
-         (declare (ignorable query-id from raw-data message inline-message-id from-id chat-id message-id))
-         (handler-case (progn ,@body)
-           (error (e)
-             (log:error "~A" e)
-             (bot-send-message (or chat-id from-id)
-                               (format nil "Ошибочка вышла~@[: ~A~]"
-                                       (when (member chat-id *admins*) e)))))))
-     (add-hook :update-callback-query ',name)))
-
-(defmacro def-callback-section-handler (name (&rest sections) &body body)
-  `(def-callback-handler ,name (callback)
-     (when chat-id
-       (multiple-value-bind (data section) (decode-callback-data chat-id raw-data)
-         (when (member section (list ,@sections))
-           (log:info query-id from-id chat-id message-id section data)
-           ,@body
-           t)))))
-
-(defun encode-oauth-state (section state)
-  (format nil "~A$~A" section state))
-(defun decode-oauth-state (raw-state)
-  (destructuring-bind (section data)
-      (split-sequence:split-sequence #\$ raw-state :count 2)
-    (values data (intern (string-upcase section) "KEYWORD"))))
-
-(defmacro def-oauth-handler (name (code error state) &body body)
-  `(progn
-     (defun ,name (,code ,error ,state)
-       (declare (ignorable ,code ,error ,state))
-       (handler-case (progn ,@body)
-         (error (e)
-           (log:error "~A" e)
-           (hunchentoot:redirect "/error"))))
-     (add-hook :oauth ',name)))
-
-(defmacro def-oauth-section-handler (name (&rest sections) &body body)
-  `(def-oauth-handler ,name (code error raw-state)
-     (multiple-value-bind (state section) (decode-oauth-state raw-state)
-       (when (member section (list ,@sections))
-         ,@body
-         t))))
-
 (defun symbol-append (&rest symbols)
   (intern (apply #'concatenate 'string
                  (mapcar #'symbol-name symbols))))
 
-;; Schedule
-(defmacro defcron (name (&rest schedule) &body body)
-  (let ((schedule (or schedule '(:minute '* :hour '*)))
-        (scheduler (symbol-append name '-scheduler)))
-    `(progn
-       (defun ,name ()
-         (unwind-protect
-              (handler-case (progn ,@body)
-                (error (e) (log:error e)))
-           (dex:clear-connection-pool)))
-       (defun ,scheduler ()
-         (clon:schedule-function
-          ',name (clon:make-scheduler
-                  (clon:make-typed-cron-schedule
-                   ,@schedule)
-                  :allow-now-p t)
-          :name ',name :thread t)
-         (values))
-       (add-hook :starting ',scheduler))))
-
 
 ;; Fix bug in local-time (following symlinks in /usr/share/zoneinfo/
 ;; leads to bad cutoff)