|
|
@@ -14,31 +14,35 @@
|
|
|
(gethash "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))))
|
|
|
+ (setf *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))))
|
|
|
- (handler-case
|
|
|
- (let* ((response (json-request url :method :post :content content
|
|
|
- :headers (list (cons :x-transmission-session-id session-id))))
|
|
|
- (result (aget "result" response)))
|
|
|
- (unless (equal "success" result)
|
|
|
- (error result))
|
|
|
- (aget "arguments" response))
|
|
|
- (dex:http-request-conflict (e)
|
|
|
- (transmission-set-session url (gethash "x-transmission-session-id" (dex:response-headers e)))
|
|
|
- (apply #'transmission-request url method arguments)))))
|
|
|
+ (let ((retries (getf arguments :retries 0)))
|
|
|
+ (when (> retries 5)
|
|
|
+ (error "Too many retries"))
|
|
|
+ (remf arguments :retries)
|
|
|
+ (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))))
|
|
|
+ (handler-case
|
|
|
+ (let* ((response (json-request url :method :post :content content
|
|
|
+ :headers (list (cons :x-transmission-session-id session-id))))
|
|
|
+ (result (aget "result" response)))
|
|
|
+ (unless (equal "success" result)
|
|
|
+ (error result))
|
|
|
+ (aget "arguments" response))
|
|
|
+ (dex:http-request-conflict (e)
|
|
|
+ (transmission-set-session url (gethash "x-transmission-session-id" (dex:response-headers e)))
|
|
|
+ (apply #'transmission-request url method :retries (1+ retries) 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)))
|