(in-package #:chatikbot) (defsetting *transmission-settings* nil "ALIST of (chat-id . url)") (defsetting *transmission-locations* nil "ALIST of (name . location)") (defsetting *transmission-monitor* nil "LIST of chat-ids where to send status updates") (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" (or (aget "torrent-added" torrent-added) (aget "torrent-duplicate" 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))))) ;; Command handlers (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 "Бота настрой!")))) (defun %torrent-add-and-respond (chat-id &key filename metainfo) (alexandria:when-let (url (aget chat-id *transmission-settings*)) (let* ((new-torrent (transmission-add-torrent url :filename filename :metainfo metainfo)) (markup (loop for (name . location) in *transmission-locations* collect (list :text (format nil "💾 ~A" name) :callback-data (encode-callback-data chat-id :tm (format nil "l-~A-~A" name (aget "id" new-torrent)) 86400))))) (bot-send-message chat-id (%format-torrent new-torrent) :reply-markup (and markup (telegram-inline-keyboard-markup (list markup))))))) (defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+")) (def-message-handler handle-magnet (message) (alexandria:when-let (magnet (ppcre:scan-to-strings +magnet-regex+ text)) (%torrent-add-and-respond chat-id :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))) (%torrent-add-and-respond chat-id :metainfo (cl-base64:usb8-array-to-base64-string (telegram-file-contents file-id)))))) ;; Callback handlers (defun %handle-torrent-move (query-id chat-id torrent-id name) (alexandria:when-let* ((url (aget chat-id *transmission-settings*)) (location (aget name *transmission-locations*))) (transmission-request url :torrent-set-location :ids torrent-id :location location :move t) (telegram-answer-callback-query query-id :text (format nil "Moved to '~A'" location)))) (def-callback-section-handler cb-handle-tm (:tm) (destructuring-bind (type val id) (split-sequence:split-sequence #\- data :count 3) (case (intern (string-upcase type) "KEYWORD") (:l (%handle-torrent-move query-id chat-id (parse-integer id) val))))) ;; Cron (defvar *transmission-last-results* (make-hash-table) "Last check results for each chat-id") (defcron process-transmission () (dolist (chat-id *transmission-monitor*) (alexandria:when-let (url (aget chat-id *transmission-settings*)) (let ((old-result (gethash chat-id *transmission-last-results*)) (new-result (loop for torrent in (transmission-get-torrents url nil '("id" "status")) collect (cons (aget "id" torrent) (aget "status" torrent))))) (when old-result (alexandria:when-let (updated (mapcar #'car (set-difference new-result old-result :test #'equal))) (bot-send-message chat-id (format nil "~{~A~^~%~}" (mapcar #'%format-torrent (transmission-get-torrents url updated)))))) (setf (gethash chat-id *transmission-last-results*) new-result)))))