[music] Pre-alpha

chatikbot.asd

@@ -23,6 +23,7 @@
                #:trivial-garbage
                #:uuid
                #:quri
+               #:jonathan
                #:yason)
   :serial t
   :components ((:file "patmatch")

plugins/music.lisp

@@ -0,0 +1,166 @@
+(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://hq2.chad-partners.com:8112/json")
+(defvar *deluge-password* "chads")
+(defvar *deluge-request-id* 1)
+
+(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)
+      (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)))
+
+(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 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)
+  (labels ((f (fl) (getf info fl)))
+    (format nil "[MUSIC] Importing *~a*, ~a tracks in ~a albums. Total size ~a"
+            (f :name) (f :wanted-files) (length (f :media-dirs)) (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)))
+
+(defvar *import-enabled* nil)
+(defun process-imports ()
+  )