chatikbot/plugins/music.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.music
  (:use :cl :chatikbot.common :alexandria))
(in-package :chatikbot.plugins.music)

(defvar *cookies* (cl-cookie:make-cookie-jar))
(defvar *deluge-api* "http://localhost:8112/json")
(defvar *deluge-password* "chads")
(defvar *deluge-request-id* 1)
(defvar *chad-music-stats-url* "http://localhost:5000/api/stats")
(defvar *chad-music-rescan-url* "http://localhost:5000/api/rescan")

(defun jojo-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 (as :plist))
  (declare (ignore method parameters 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))
  (remf args :as)
  (when content
    (push (cons :content-type "application/json") headers))
  (remf args :headers)
  (multiple-value-bind (body status headers uri)
      (handler-bind
	  ((sb-int:broken-pipe #'(lambda (c) (declare (ignorable c))
				   (invoke-restart (find-restart 'dexador:retry-request)))))
	(apply #'http-request url :headers headers args))
    (unless (stringp body)
      (setf body (trivial-utf-8:utf-8-bytes-to-string body)))
    (values (jojo:parse body :as as) status headers uri)))

(defun deluge-request (method &optional params is-auth)
  (let* ((content (trivial-utf-8:string-to-utf-8-bytes
                   (jojo:to-json `(:|id| ,(incf *deluge-request-id*)
                                    :|method| ,method
                                    :|params| ,params))))
         (response (jojo-request *deluge-api* :method :post
                                 :content content
                                 :cookie-jar *cookies*))
         (error-message (getf (getf response :|error|) :|message|)))
    (if error-message
        (if (and (null is-auth)
                 (equal error-message "Not authenticated"))
            (progn
              (deluge-auth)
              (deluge-request method params t)) ;; Retry original request
            (error error-message))
        (getf response :|result|))))

(defun deluge-auth ()
  (deluge-request "auth.login" (list *deluge-password*) t))

(defun infohash-magnet (info-hash)
  (concatenate 'string "magnet:?xt=urn:btih:" info-hash))

(defun deluge-add-info-hash (info-hashes)
  (unless (listp info-hashes)
    (setf info-hashes (list info-hashes)))
  (let ((torrents (loop for ih in info-hashes
                     collect (list :|path| (infohash-magnet ih)
                                   :|options| '(:|add_paused| :true)))))
    (deluge-request "web.add_torrents" (list torrents))))

(defun deluge-get-torrents ()
  (deluge-request "core.get_session_state"))

(defun deluge-get-torrent-status (info-hash fields)
  (deluge-request "core.get_torrent_status" (list info-hash fields)))

(defun deluge-get-torrents-status (filter fields)
  (deluge-request "core.get_torrents_status" (list filter fields)))

(defun deluge-remove-torrent (ih &optional from-disk)
  (deluge-request "core.remove_torrent" (list ih from-disk)))

(defparameter +deluge-default-status-fields+ '("name" "state" "save_path" "files" "file_priorities" "total_size" "total_wanted" "total_done" "num_files"))
(defun raw-pathname (pathspec)
  (values (cl-ppcre:regex-replace-all "\\[" pathspec "\\\\[")))

(defun deluge-get-torrent-files (info-hash)
  (let* ((status (deluge-request "core.get_torrent_status" (list info-hash +deluge-default-status-fields+)))
         (save-path (getf status :|save_path|)))
    (loop for file in (getf status :|files|)
       for prio in (getf status :|file_priorities|)
       do (setf (getf file :|prio|) prio
                (getf file :|path|) (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|)))))
	  collect file)))

(defun deluge-add-torrent-magnet (uri &optional options)
  (deluge-request "core.add_torrent_magnet" (list uri options)))

(defun get-non-skipped (files)
  (remove 0 files :key (lambda (f) (getf f :|prio|))))

(defun get-files-folders (files)
  (delete-duplicates (mapcar (lambda (f) (uiop:pathname-directory-pathname (getf f :|path|))) files)))

(defparameter +media-exts+ '("mp3" "flac" "ac3"))
(defun media-p (path)
  (let* ((ext (subseq path (1+ (or (position #\. path :from-end t) (1- (length path)))))))
    (member (string-downcase ext) +media-exts+ :test #'equal)))

(defun get-torrent-info (status)
  (labels ((f (field)
             (getf status field)))
    (let ((wanted-dirs (loop for file in (f :|files|)
                             for prio in (f :|file_priorities|)
                             for path = (getf file :|path|)
                             when (media-p path)
                             unless (= prio 0)
                             collect (subseq path 0 (1+ (position #\/ path :from-end t))))))
      (list
       :name (f :|name|)
       :state (keyify (f :|state|))
       :save-path (f :|save_path|)
       :total-size (f :|total_size|)
       :total-wanted (f :|total_wanted|)
       :total-done (f :|total_done|)
       :num-files (f :|num_files|)
       :wanted-files (length wanted-dirs)
       :media-dirs (remove-duplicates wanted-dirs :test #'equal)))))

(defun get-import-notify (info action)
  (labels ((f (fl) (getf info fl)))
    (format nil "[[🎶]] ~a *~a*, ~a альбомов с ~a треками. Весит ~a" action
            (f :name) (length (f :media-dirs)) (f :wanted-files) (format-size (f :total-wanted)))))

(defun get-root-paths (info)
  (let ((roots (delete-duplicates (loop for dir in (getf info :media-dirs)
                                        collect (subseq dir 0 (1+ (position #\/ dir))))
                                  :test #'equal))
        (save (getf info :save-path)))
    (mapcar #'(lambda (r) (concatenate 'string save "/" r)) roots)))

(defvar *beet-bin* '("sudo" "-u" "uploader" "/home/uploader/.local/bin/beet"))
(defun beets-import-cmd (paths)
  (append *beet-bin*
          (list "import" "--move" "--quiet")
          paths))

(defun run-import (paths &optional dry)
  (let ((cmd (beets-import-cmd paths)))
    (if dry (format t "Running ~{~a~^ ~}" cmd)
        (uiop:run-program cmd))))

(defun deluge-get-seeding-torrents ()
  (loop for (torrent state) on (deluge-get-torrents-status '(:|state| "Seeding") '("name")) by #'cddr
     collect (cons (string torrent) (getf state :|name|))))

(defun deluge-pause-torrents (&rest torrents)
  (deluge-request "core.pause_torrent" (list torrents)))

(defun deluge-delete-skipped (torrent &optional dry)
  (let* ((status (deluge-request "core.get_torrent_status" (list torrent +deluge-default-status-fields+)))
         (save-path (getf status :|save_path|)))
    (loop for file in (getf status :|files|)
       for prio in (getf status :|file_priorities|)
       for path = (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|))))
       when (zerop prio)
       when (probe-file path)
       do (if dry (format t "Deleting '~A'~%" path)
              (uiop:delete-file-if-exists path)))))

(defun send-admins (msg &optional dry)
  (if dry (format t "~a~%" msg)
      (loop for *chat-id* in (lists-get :music-admins)
            do (bot-send-message msg :parse-mode "markdown"))))

(defun process-downloaded (ih &optional dry)
  (let* ((status (deluge-get-torrent-status ih +deluge-default-status-fields+))
         (info (get-torrent-info status))
         (notify (get-import-notify info "Добавляем"))
         (paths (get-root-paths info)))
    (send-admins notify dry)
    (deluge-pause-torrents ih)
    (deluge-delete-skipped ih dry)
    (run-import paths dry)
    (json-request *chad-music-rescan-url* :method :post)
    (if dry (format t "Removing torrent ~a" ih)
      (deluge-remove-torrent ih))))

(defun process-imports ()
  (loop
    (loop for (ih . name) in (deluge-get-seeding-torrents)
	  do (handler-case (process-downloaded ih)
	       (error (c) (log:error "Error processing torrent" name c))))
    (sleep 1)))

(defvar *watcher* nil "Importer thread ")
(defvar *lock* (bordeaux-threads:make-recursive-lock "Music watch"))
(defun ensure-watcher ()
  (bt:with-recursive-lock-held (*lock*)
    (if (lists-get :music-watch)
        (unless *watcher*
          (setf *watcher* (bt:make-thread 'process-imports :name "music watch")))
        (when *watcher*
          (bt:destroy-thread *watcher*)
          (setf *watcher* nil))))
  (values))

(defun handle-set-watch (enable)
  (lists-set-entry :music-watch *chat-id* enable)
  (ensure-watcher)
  (bot-send-message (if enable "[🎶] Импортим музло" "[🎶] Пусть мешки парятся")))

(defun handle-status ()
  (let* ((db-stats (when *chad-music-stats-url*
		     (json-request *chad-music-stats-url*)))
	 (stats (loop
		 for (torrent status) on (deluge-get-torrents-status nil '("state" "name" "total_wanted")) by #'cddr
		 for state = (getf status :|state|)
		 when (equal state "Downloading") counting t into down
		 when (equal state "Seeding") counting t into seed
		 summing (getf status :|total_wanted|) into size
		 finally (return (list :down down :seed seed :size size)))))
	 (bot-send-message (format nil "[[🎶]] Осталось скачать ~a, заимпортить ~a торрентов, общий объём ~a.~%Сейчас в базе ~a исполнителей с ~a альбомами и ~a треками, общей длительностью ~a"
				   (getf stats :down) (getf stats :seed) (format-size (getf stats :size))
				   (agets db-stats "artists")
				   (agets db-stats "albums")
				   (agets db-stats "tracks")
				   (agets db-stats "duration"))
		      :parse-mode "markdown")))


(defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
(defun handle-add-torrent (magnet)
  (let* ((ih (deluge-add-torrent-magnet magnet))
	 (status (deluge-get-torrent-status ih +deluge-default-status-fields+))
         (info (get-torrent-info status))
         (notify (get-import-notify info "Качаем")))
    (bot-send-message notify)))

(def-message-cmd-handler handle-cmd-music (:music)
  (with-chat-in-list :music-admins
    (let ((arg (car *args*)))
    (cond
      ((and (= 1 (length *args*)) (member (string-downcase arg) '("on" "off") :test 'equal))
       (handle-set-watch (equal "on" arg)))
      ((ppcre:scan-to-strings +magnet-regex+ arg)
       (handle-add-torrent (ppcre:scan-to-strings +magnet-regex+ arg)))
      (:otherwise (handle-status))))))

(add-hook :starting #'ensure-watcher)