Fix timeout handling (again)

chatikbot.lisp

@@ -131,7 +131,7 @@
           (when (> id *akb-last-id*)
             (send-akb (format-akb post))
             (setf *akb-last-id* id))))
-    (condition (e) (log:error e))))
+    (error (e) (log:error e))))
 
 (defun send-akb (text)
   (log:info "send-akb: ~A" text)
@@ -139,7 +139,7 @@
     (handler-case
         (telegram-send-message chat-id text
                                :disable-web-preview 1)
-      (condition (e) (log:error e)))))
+      (error (e) (log:error e)))))
 
 (defun handle-cmd-akb (chat-id message-id args)
   (log:info "handle-cmd-akb" chat-id message-id args)
@@ -154,8 +154,8 @@
 		(telegram-send-message chat-id
 				       (format-akb post)
 				       :disable-web-preview 1)
-	      (condition (e) (log:error e))))))
-    (condition (e)
+	      (error (e) (log:error e))))))
+    (error (e)
       (log:error e)
       (telegram-send-message chat-id "some shit happened"))))
 

telegram.lisp

@@ -28,12 +28,15 @@
                            *telegram-timeout*)))
          (response (yason:parse
                     (flexi-streams:octets-to-string
-                     (bordeaux-threads:with-timeout (timeout)
-                       (dex:post (format nil +telegram-api-format+ *telegram-token* method)
-                                 :content params
-                                 :use-connection-pool t
-                                 :force-binary t))
-                     :external-format :utf8)
+		     (handler-case
+			 (bordeaux-threads:with-timeout (timeout)
+			   (dex:post (format nil +telegram-api-format+ *telegram-token* method)
+				     :content params
+				     :use-connection-pool t
+				     :force-binary t))
+		       (bordeaux-threads:timeout (e)
+			 (error e)))
+		       :external-format :utf8)
                     :object-as :alist)))
     (unless (aget "ok" response)
       (error (aget "description" response)))

utils.lisp

@@ -11,7 +11,13 @@
              (progn
                (funcall func)
                (setf backoff *backoff-start*))
-           (condition (e)
+           (error (e)
+             (log:error e)
+             (log:info "Backing off for" backoff)
+             (sleep backoff)
+             (setf backoff (min *backoff-max*
+                                (* 2 backoff))))
+	   (bordeaux-threads:timeout (e)
              (log:error e)
              (log:info "Backing off for" backoff)
              (sleep backoff)

vk.lisp

@@ -3,23 +3,26 @@
 (defparameter +vk-api-url+ "https://api.vk.com/method/~A?v=5.34" "VK.com API endpoint")
 
 (defun %vk-api-call (method &optional args)
-  (bordeaux-threads:with-timeout (5)
-    (let* ((params (loop for (k . v) in args
-		      when v
-		      collect (cons
-			       (princ-to-string k)
-			       (princ-to-string v))))
-	   (response (yason:parse
-		      (flexi-streams:octets-to-string
-		       (drakma:http-request (format nil +vk-api-url+ method)
-					    :method :post
-					    :parameters params
-					    :external-format-out :utf8)
-		       :external-format :utf8)
-		      :object-as :alist)))
-      (when (aget "error" response)
-	(error (aget "error_msg" (aget "error" response))))
-      (aget "response" response))))
+  (handler-case
+      (bordeaux-threads:with-timeout (5)
+	(let* ((params (loop for (k . v) in args
+			  when v
+			  collect (cons
+				   (princ-to-string k)
+				   (princ-to-string v))))
+	       (response (yason:parse
+			  (flexi-streams:octets-to-string
+			   (drakma:http-request (format nil +vk-api-url+ method)
+						:method :post
+						:parameters params
+						:external-format-out :utf8)
+			   :external-format :utf8)
+			  :object-as :alist)))
+	  (when (aget "error" response)
+	    (error (aget "error_msg" (aget "error" response))))
+	  (aget "response" response)))
+    (bordeaux-threads:timeout (e)
+      (error e))))
 
 (defun vk-wall-get (&key owner-id domain offset count filter extended)
   (%vk-api-call "wall.get"