transmission v0.1

chatikbot.asd

@@ -8,6 +8,7 @@
                #:bordeaux-threads
                #:cl-date-time-parser
                #:cl-ppcre
+               #:cl-base64
                #:clon
                #:clss
                #:drakma

chatikbot.lisp

@@ -41,7 +41,7 @@
   (log:info update)
   (loop for (key . value) in update
      unless (equal "update_id" key)
-     do (run-hooks (string-to-event (format nil "update-~A" key)) value)))
+     do (run-hooks (keyify (format nil "update-~A" key)) value)))
 
 (def-message-admin-cmd-handler handle-admin-settings (:settings)
   (send-response chat-id

plugins/transmission.lisp

@@ -0,0 +1,99 @@
+(in-package #:chatikbot)
+
+(defsetting *transmission-settings* nil "ALIST of (chat-id . url)")
+
+(defvar *transmission-sessions* nil "ALIST of (url . x-transmission-session-id)")
+
+(defun transmission-get-session (url)
+  (multiple-value-bind (body status headers uri stream)
+      (drakma:http-request url :force-binary t :decode-content t)
+    (declare (ignore body status uri stream))
+    (aget :x-transmission-session-id headers)))
+
+(defun transmission-set-session (url session-id)
+  (set-setting '*transmission-sessions*
+               (cons (cons url session-id)
+                     (remove url *transmission-sessions* :test #'equal :key #'car))))
+
+(defun transmission-request (url method &rest arguments)
+  (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))))
+    (multiple-value-bind (stream status headers uri http-stream)
+        (drakma:http-request url :method :post :content content :content-type "application/json"
+                             :force-binary t :want-stream t :decode-content t
+                             :additional-headers (list (cons :x-transmission-session-id session-id)))
+      (declare (ignore uri))
+      (ecase status
+        (200 (unwind-protect
+                  (progn
+                    (setf (flex:flexi-stream-external-format stream) :utf-8)
+                    (let* ((response (yason:parse stream :object-as :alist))
+                           (result (aget "result" response)))
+                      (unless (equal "success" result)
+                        (error result))
+                      (aget "arguments" response)))
+               (ignore-errors (close http-stream))))
+        (409 (transmission-set-session url (aget :x-transmission-session-id headers))
+             (apply #'transmission-request url method 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)))
+
+(defun transmission-add-torrent (url &key filename metainfo)
+  (let ((torrent-added (transmission-request url :torrent-add :filename filename :metainfo metainfo)))
+   (car (transmission-get-torrents url (list (aget "id" (aget "torrent-added" torrent-added)))))))
+
+(defun %format-torrent-status (status)
+  (case status
+    (0 "⏹") ;; Stopped
+    (1 "🔂") ;; Check wait
+    (2 "🔁") ;; Check
+    (3 "⏸") ;; Queued to download
+    (4 "▶️") ;; Downloading
+    (5 "⏸") ;; Queued to seed
+    (6 "⏺") ;; Seeding
+    ))
+
+(defun %format-torrent (torrent)
+  (let ((eta (aget "eta" torrent)))
+    (format nil "~A ~A ~A (~A)~:[~; (~A%~@[, eta ~A~])~]"
+            (aget "id" torrent)
+            (%format-torrent-status (aget "status" torrent))
+            (aget "name" torrent)
+            (format-size (aget "totalSize" torrent))
+            (eq 4 (aget "status" torrent))
+            (smart-f (* 100 (aget "percentDone" torrent)) 1)
+            (when (not (= -1 eta)) (format-interval eta)))))
+
+(def-message-cmd-handler handle-torrents (:torrents)
+  (let ((url (aget chat-id *transmission-settings*)))
+    (if url
+        (bot-send-message chat-id
+                          (format nil "~{~A~^~%~}" (mapcar #'%format-torrent
+                                                           (transmission-get-torrents url))))
+        (bot-send-message chat-id "Бота настрой!"))))
+
+(defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
+
+(def-message-handler handle-magnet (message)
+  (alexandria:when-let* ((url (aget chat-id *transmission-settings*))
+                         (magnet (ppcre:scan-to-strings +magnet-regex+ text)))
+    (bot-send-message chat-id (%format-torrent (transmission-add-torrent url :filename magnet)))))
+
+(def-message-handler handle-torrent (message)
+  (alexandria:when-let* ((url (aget chat-id *transmission-settings*))
+                         (doc (aget "document" message))
+                         (file-name (aget "file_name" doc))
+                         (file-id (aget "file_id" doc)))
+    (when (and (equal "torrent" (pathname-type (pathname file-name)))
+               (< (aget "file_size" doc) (* 512 1024)))
+      (let ((contents (telegram-file-content file-id)))
+        (bot-send-message chat-id (%format-torrent (transmission-add-torrent url :metainfo (cl-base64:usb8-array-to-base64-string contents))))))))

telegram.lisp

@@ -2,6 +2,7 @@
 
 (defvar *telegram-token* nil "Telegram bot token")
 (defparameter +telegram-api-format+ "https://api.telegram.org/bot~A/~A")
+(defparameter +telegram-file-format+ "https://api.telegram.org/file/bot~A/~A")
 (defvar *telegram-timeout* 30 "Default Telegram timeout")
 
 (defun %telegram-api-call (method &optional args)
@@ -132,6 +133,12 @@
 (defun telegram-get-file (file-id)
   (%telegram-api-call "getFile" `(("file_id" . ,file-id))))
 
+(defun telegram-file-contents (file-id)
+  (let* ((file (telegram-get-file file-id))
+         (file-path (aget "file_path" file))
+         (file-url (format nil +telegram-file-format+ *telegram-token* file-path)))
+    (drakma:http-request file-url :force-binary t :decode-content t)))
+
 ;; Simplified interface
 ;;
 (defun send-response (chat-id response &optional reply-id)

utils.lisp

@@ -22,9 +22,13 @@
   (setf (gethash event *hooks*)
         (remove hook (gethash event *hooks*))))
 
-(defun string-to-event (key)
+(defun keyify (key)
   (intern (string-upcase (substitute #\- #\_ key)) :keyword))
 
+(defun dekeyify (keyword &optional preserve-dash)
+  (let ((text (string-downcase (string keyword))))
+    (if preserve-dash text (substitute #\_ #\- text))))
+
 ;; Settings
 (defvar *settings* nil "List of plugin's settings symbols")
 (defmacro defsetting (var &optional val doc)
@@ -171,6 +175,31 @@ is replaced with replacement."
                                 :format '(:year "-" (:month 2) "-" (:day 2) " "
                                           (:hour 2) ":" (:min 2) ":" (:sec 2))))
 
+(defun smart-f (arg &optional digits)
+  (with-output-to-string (s)
+    (prin1 (cond ((= (round arg) arg) (round arg))
+                 (digits (float (/ (round (* arg (expt 10 digits)))
+                                   (expt 10 digits))))
+                 (t arg))
+           s)))
+
+(defun format-size (bytes)
+  (cond
+    ((< bytes 512) (smart-f bytes))
+    ((< bytes (* 512 1024)) (format nil "~A KiB" (smart-f (/ bytes 1024) 1)))
+    ((< bytes (* 512 1024 1024)) (format nil "~A MiB" (smart-f (/ bytes 1024 1024) 1)))
+    ((< bytes (* 512 1024 1024 1024)) (format nil "~A GiB" (smart-f (/ bytes 1024 1024 1024) 1)))
+    (:otherwise (format nil "~A TiB" (smart-f (/ bytes 1024 1024 1024 1024) 1)))))
+
+(defun format-interval (seconds)
+  (cond
+    ((< seconds 60) (format nil "~A sec" seconds))
+    ((< seconds (* 60 60)) (format nil "~A mins" (round seconds 60)))
+    ((< seconds (* 60 60 24)) (format nil "~A hours" (round seconds (* 60 60))))
+    ((< seconds (* 60 60 24 7)) (format nil "~A days" (round seconds (* 60 60 24))))
+    ((< 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 google-tts (text &key (lang "en"))
   (let ((path #P"google_tts.mp3"))
     (with-open-file (s path :direction :output