[music] slskd auto-import

plugins/music.lisp

@@ -9,12 +9,17 @@
 (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")
+(defvar *slskd-api* "http://localhost:5015/api/v0")
+(defvar *slskd-downloads-dir* "/data/uploads/batch2/")
 
-(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))
+(defun jojo-request (url &rest args &key method parameters content headers basic-auth bearer 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)
+  (remf args :bearer)
   (when content
     (push (cons :content-type "application/json") headers))
+  (when bearer
+    (push (cons :authorization (format nil "Bearer ~a" bearer)) headers))
   (remf args :headers)
   (multiple-value-bind (body status headers uri)
       (handler-bind
@@ -38,13 +43,10 @@
         (if (and (null is-auth)
                  (equal error-message "Not authenticated"))
             (progn
-              (deluge-auth)
+	      (deluge-request "auth.login" (list *deluge-password*) t)
               (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))
+            (error (format nil "Deluge error: ~a" error-message)))
+        (getf response :|result|))))  
 
 (defun infohash-magnet (info-hash)
   (concatenate 'string "magnet:?xt=urn:btih:" info-hash))
@@ -109,17 +111,24 @@
        :name (f :|name|)
        :state (keyify (f :|state|))
        :save-path (f :|save_path|)
+       :total-files (f :|num_files|)
        :total-size (f :|total_size|)
-       :total-wanted (f :|total_wanted|)
-       :total-done (f :|total_done|)
-       :num-files (f :|num_files|)
+       :total-size-left (- (f :|total_size|) (f :|total_done|))
        :wanted-files (length wanted-dirs)
+       :wanted-size (f :|total_wanted|)
        :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)))))
+    (format nil "[[🎶]] ~a *~a*, ~a альбомов с ~a треками. Весит ~a.~@[ Осталось ~a треков, ~a~]" action
+            (f :name)
+	    (length (f :media-dirs))
+	    (f :wanted-files)
+	    (format-size (f :wanted-size))
+	    (when (and (f :wanted-files-left) (positive-integer-p (f :wanted-files-left)))
+	      (f :wanted-files-left))
+	    (when (and (f :wanted-size-left) (positive-integer-p (f :wanted-size-left)))
+	      (format-size (f :wanted-size-left))))))
 
 (defun get-root-paths (info)
   (let ((roots (delete-duplicates (loop for dir in (getf info :media-dirs)
@@ -158,29 +167,138 @@
        do (if dry (format t "Deleting '~A'~%" path)
               (uiop:delete-file-if-exists path)))))
 
-(defun send-admins (msg &optional dry)
+(defun send-notify (msg &optional dry)
   (if dry (format t "~a~%" msg)
-      (loop for *chat-id* in (lists-get :music-admins)
+      (loop for *chat-id* in (lists-get :music-notify)
             do (bot-send-message msg :parse-mode "markdown"))))
 
-(defun process-downloaded (ih &optional dry)
+(defun request-chad-music-rescan ()
+  (json-request *chad-music-rescan-url* :method :post))
+
+(defun process-downloaded-torrent (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)
+    (send-notify notify dry)
     (deluge-pause-torrents ih)
     (deluge-delete-skipped ih dry)
     (run-import paths dry)
-    (json-request *chad-music-rescan-url* :method :post)
+    (request-chad-music-rescan)
     (if dry (format t "Removing torrent ~a" ih)
-      (deluge-remove-torrent ih))))
-
+	(deluge-remove-torrent ih))))
+
+(defvar *slskd-bearer* nil)
+(defun slskd-request (path &key method parameters content is-auth)
+  (let* ((content (when content (trivial-utf-8:string-to-utf-8-bytes
+				 (jojo:to-json content)))))
+    (handler-case (jojo-request (format nil "~a/~a" *slskd-api* path)
+				:bearer *slskd-bearer*
+				:method method				
+                                :content content
+				:parameters parameters)
+      (dex:http-request-unauthorized ()
+	(unless is-auth
+	  (with-secret ((&optional username password) '(:slskd))
+	    (setf *slskd-bearer*
+		  (getf (slskd-request "session"
+				       :method :post
+                   		       :content `(:|username| ,username
+						   :|password| ,password)
+				       :is-auth t)
+			:|token|)))
+	  (slskd-request path :method method :parameters parameters :content content))))))
+
+
+(defun slskd-get-download-directories ()
+  (loop for dl in (slskd-request "transfers/downloads" :method :get)
+        append (getf dl :|directories|)))
+
+(defun slskd-file-succeeded-p (file)
+  (equal (getf file :|state|) "Completed, Succeeded"))
+
+(defun slskd-file-complete-error-p (file)
+  (let ((state (getf file :|state|)))
+    (and (not (slskd-file-succeeded-p file))
+	 (equal (subseq state 0 (min (length state) 11))
+		"Completed, "))))
+
+(defun slskd-download-file (file)
+  (jojo-request (format nil "~a/~a" *slskd-downloads-url* (getf file :|username|))
+		:method :post
+		:content (trivial-utf-8:string-to-utf-8-bytes
+			  (jojo:to-json `(:|filename| ,(getf file :|filename|)
+                                           :|size| ,(getf file :|size|))))))
+
+(defun slskd-remove-download (file)
+  (jojo-request (format nil "~a/~a/~a" *slskd-downloads-url*
+			(getf file :|username|)
+			(getf file :|id|))
+		:method :delete
+		:parameters `(("remove" . "true"))))
+
+(defun slskd-get-download-path (dir)
+  (format nil "~a~a" *slskd-downloads-dir*
+	  (subseq (getf dir :|directory|)
+		  (1+ (position #\\ (getf dir :|directory|) :from-end t)))))
+(defun get-slskd-dir-info (dir)
+  (labels ((f (field)
+             (getf dir field)))
+    (multiple-value-bind (total-files total-files-left total-size total-size-left wanted-files wanted-files-left wanted-size wanted-size-left)
+	(loop for file in (f :|files|)
+              for path = (getf file :|filename|)
+	      for file-left = (not (slskd-file-succeeded-p file))
+	      for size = (getf file :|size|)
+	      for size-left = (getf file :|bytesRemaining|)
+	      count file into total-files
+	      count file-left into total-files-left
+	      sum size into total-size
+	      sum size-left into total-size-left 
+              when (media-p path)
+              count file into wanted-files and
+	      count file-left into wanted-files-left and
+	      sum size into wanted-size and
+	      sum size-left into wanted-size-left
+	      finally (return (values total-files total-files-left total-size total-size-left wanted-files wanted-files-left wanted-size wanted-size-left)))
+      (list
+       :name (f :|directory|)
+       :save-path (slskd-get-download-path dir)
+       :total-files total-files
+       :total-files-left total-files-left
+       :total-size total-size
+       :total-size-left total-size-left
+       :wanted-files wanted-files
+       :wanted-files-left wanted-files-left
+       :wanted-size wanted-size
+       :wanted-size-left wanted-size-left
+       :media-dirs (list (f :|directory|))))))
+
+
+(defun slskd-download-complete-p (dir)
+  (every #'slskd-file-succeeded-p (getf dir :|files|)))
+
+(defun slskd-process-download-dir (dir)
+  (let ((files (getf dir :|files|)))
+    ;; Retry failed
+    (when (some #'slskd-file-succeeded-p files)
+      (loop for file in files
+            when (slskd-file-complete-error-p file)
+              do (slskd-download-file file)))
+    ;; Import complete
+    (when (every #'slskd-file-succeeded-p files)
+      (send-notify (get-import-notify (get-slskd-dir-info dir) "Добавляем"))
+      (run-import (slskd-get-download-path dir))
+      (loop for file in files do (slskd-remove-download file))
+      (request-chad-music-rescan))))
+  
 (defun process-imports ()
   (loop
     (loop for (ih . name) in (deluge-get-seeding-torrents)
-	  do (handler-case (process-downloaded ih)
+	  do (handler-case (process-downloaded-torrent ih)
 	       (error (c) (log:error "Error processing torrent" name c))))
+    (loop for dir in (slskd-get-download-directories)
+          do (handler-case (slskd-process-download-dir dir)
+               (error (c) (log:error "Error processing slskd" c))))
     (sleep 1)))
 
 (defvar *watcher* nil "Importer thread ")
@@ -221,11 +339,13 @@
 
 (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)))
+  (let ((ih (deluge-add-torrent-magnet magnet)))
+    (bot-send-message
+     (if ih
+	 (let* ((status (deluge-get-torrent-status ih +deluge-default-status-fields+))
+		(info (get-torrent-info status)))
+	   (get-import-notify info "Качаем"))
+	 "Не добавил. Может уже?"))))
 
 (def-message-cmd-handler handle-cmd-music (:music)
   (with-chat-in-list :music-admins

secrets.lisp

@@ -47,8 +47,13 @@
      (secret-wipe (car data))
      (secret-wipe (cdr data)))))
 
-(defmacro with-secret ((var path) &body body)
-  `(let ((,var (ignore-errors (secret-get ,path))))
-     (unwind-protect
-          (progn ,@body)
-       (secret-wipe ,var))))
+(defmacro with-secret ((vars path) &body body)
+  (alexandria:with-gensyms (secret)
+    `(let ((,secret (ignore-errors (secret-get ,path))))
+       (unwind-protect
+	    ,(if (listp vars)
+		 `(destructuring-bind ,vars ,secret ,@body)
+		 `(let ((,vars ,secret)) ,@body))
+	 (secret-wipe ,secret)))))
+
+