music.lisp 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166
  1. (in-package :cl-user)
  2. (defpackage chatikbot.plugins.music
  3. (:use :cl :chatikbot.common :alexandria))
  4. (in-package :chatikbot.plugins.music)
  5. (defvar *cookies* (cl-cookie:make-cookie-jar))
  6. (defvar *deluge-api* "http://hq2.chad-partners.com:8112/json")
  7. (defvar *deluge-password* "chads")
  8. (defvar *deluge-request-id* 1)
  9. (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))
  10. (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))
  11. (remf args :as)
  12. (when content
  13. (push (cons :content-type "application/json") headers))
  14. (remf args :headers)
  15. (multiple-value-bind (body status headers uri)
  16. (apply #'http-request url :headers headers args)
  17. (unless (stringp body)
  18. (setf body (trivial-utf-8:utf-8-bytes-to-string body)))
  19. (values (jojo:parse body :as as) status headers uri)))
  20. (defun deluge-request (method &optional params is-auth)
  21. (let* ((content (trivial-utf-8:string-to-utf-8-bytes
  22. (jojo:to-json `(:|id| ,(incf *deluge-request-id*)
  23. :|method| ,method
  24. :|params| ,params))))
  25. (response (jojo-request *deluge-api* :method :post
  26. :content content
  27. :cookie-jar *cookies*))
  28. (error-message (getf (getf response :|error|) :|message|)))
  29. (if error-message
  30. (if (and (null is-auth)
  31. (equal error-message "Not authenticated"))
  32. (progn
  33. (deluge-auth)
  34. (deluge-request method params t)) ;; Retry original request
  35. (error error-message))
  36. (getf response :|result|))))
  37. (defun deluge-auth ()
  38. (deluge-request "auth.login" (list *deluge-password*) t))
  39. (defun infohash-magnet (info-hash)
  40. (concatenate 'string "magnet:?xt=urn:btih:" info-hash))
  41. (defun deluge-add-info-hash (info-hashes)
  42. (unless (listp info-hashes)
  43. (setf info-hashes (list info-hashes)))
  44. (let ((torrents (loop for ih in info-hashes
  45. collect (list :|path| (infohash-magnet ih)
  46. :|options| '(:|add_paused| :true)))))
  47. (deluge-request "web.add_torrents" (list torrents))))
  48. (defun deluge-get-torrents ()
  49. (deluge-request "core.get_session_state"))
  50. (defun deluge-get-torrent-status (info-hash fields)
  51. (deluge-request "core.get_torrent_status" (list info-hash fields)))
  52. (defun deluge-get-torrents-status (filter fields)
  53. (deluge-request "core.get_torrents_status" (list filter fields)))
  54. (defparameter +deluge-default-status-fields+ '("name" "state" "save_path" "files" "file_priorities" "total_size" "total_wanted" "total_done" "num_files"))
  55. (defun raw-pathname (pathspec)
  56. (values (cl-ppcre:regex-replace-all "\\[" pathspec "\\\\[")))
  57. (defun deluge-get-torrent-files (info-hash)
  58. (let* ((status (deluge-request "core.get_torrent_status" (list info-hash +deluge-default-status-fields+)))
  59. (save-path (getf status :|save_path|)))
  60. (loop for file in (getf status :|files|)
  61. for prio in (getf status :|file_priorities|)
  62. do (setf (getf file :|prio|) prio
  63. (getf file :|path|) (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|)))))
  64. collect file)))
  65. (defun get-non-skipped (files)
  66. (remove 0 files :key (lambda (f) (getf f :|prio|))))
  67. (defun get-files-folders (files)
  68. (delete-duplicates (mapcar (lambda (f) (uiop:pathname-directory-pathname (getf f :|path|))) files)))
  69. (defparameter +media-exts+ '("mp3" "flac" "ac3"))
  70. (defun media-p (path)
  71. (let* ((ext (subseq path (1+ (or (position #\. path :from-end t) (1- (length path)))))))
  72. (member (string-downcase ext) +media-exts+ :test #'equal)))
  73. (defun get-torrent-info (status)
  74. (labels ((f (field)
  75. (getf status field)))
  76. (let ((wanted-dirs (loop for file in (f :|files|)
  77. for prio in (f :|file_priorities|)
  78. for path = (getf file :|path|)
  79. when (media-p path)
  80. unless (= prio 0)
  81. collect (subseq path 0 (1+ (position #\/ path :from-end t))))))
  82. (list
  83. :name (f :|name|)
  84. :state (keyify (f :|state|))
  85. :save-path (f :|save_path|)
  86. :total-size (f :|total_size|)
  87. :total-wanted (f :|total_wanted|)
  88. :total-done (f :|total_done|)
  89. :num-files (f :|num_files|)
  90. :wanted-files (length wanted-dirs)
  91. :media-dirs (remove-duplicates wanted-dirs :test #'equal)))))
  92. (defun get-import-notify (info)
  93. (labels ((f (fl) (getf info fl)))
  94. (format nil "[MUSIC] Importing *~a*, ~a tracks in ~a albums. Total size ~a"
  95. (f :name) (f :wanted-files) (length (f :media-dirs)) (format-size (f :total-wanted)))))
  96. (defun get-root-paths (info)
  97. (let ((roots (delete-duplicates (loop for dir in (getf info :media-dirs)
  98. collect (subseq dir 0 (1+ (position #\/ dir))))
  99. :test #'equal))
  100. (save (getf info :save-path)))
  101. (mapcar #'(lambda (r) (concatenate 'string save "/" r)) roots)))
  102. (defvar *beet-bin* '("sudo" "-u" "uploader" "/home/uploader/.local/bin/beet"))
  103. (defun beets-import-cmd (paths)
  104. (append *beet-bin*
  105. (list "import" "--move" "--quiet")
  106. paths))
  107. (defun run-import (paths &optional dry)
  108. (let ((cmd (beets-import-cmd paths)))
  109. (if dry (format t "Running ~{~a~^ ~}" cmd)
  110. (uiop:run-program cmd))))
  111. (defun deluge-get-seeding-torrents ()
  112. (loop for (torrent state) on (deluge-get-torrents-status '(:|state| "Seeding") '("name")) by #'cddr
  113. collect (cons (string torrent) (getf state :|name|))))
  114. (defun deluge-pause-torrents (&rest torrents)
  115. (deluge-request "core.pause_torrent" (list torrents)))
  116. (defun deluge-delete-skipped (torrent &optional dry)
  117. (let* ((status (deluge-request "core.get_torrent_status" (list torrent +deluge-default-status-fields+)))
  118. (save-path (getf status :|save_path|)))
  119. (loop for file in (getf status :|files|)
  120. for prio in (getf status :|file_priorities|)
  121. for path = (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|))))
  122. when (zerop prio)
  123. when (probe-file path)
  124. do (if dry (format t "Deleting '~A'~%" path)
  125. (uiop:delete-file-if-exists path)))))
  126. (defun send-admins (msg &optional dry)
  127. (if dry (format t "~a~%" msg)
  128. (loop for *chat-id* in (lists-get :music-admins)
  129. do (bot-send-message msg :parse-mode "markdown"))))
  130. (defun process-downloaded (ih &optional dry)
  131. (let* ((status (deluge-get-torrent-status ih +deluge-default-status-fields+))
  132. (info (get-torrent-info status))
  133. (notify (get-import-notify info))
  134. (paths (get-root-paths info)))
  135. (send-admins notify dry)
  136. (deluge-pause-torrents ih)
  137. (deluge-delete-skipped ih dry)
  138. (run-import paths dry)))
  139. (defvar *import-enabled* nil)
  140. (defun process-imports ()
  141. )