/
transmission.el
1679 lines (1483 loc) · 69.7 KB
/
transmission.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; transmission.el --- Interface to a Transmission session -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Mark Oteiza <mvoteiza@udel.edu>
;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Version: 0.9
;; Package-Requires: ((emacs "24.4") (let-alist "1.0.3"))
;; Keywords: comm, tools
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Interface to a Transmission session.
;; Originally based on the JSON RPC library written by Christopher
;; Wellons, available online at
;; <https://github.com/skeeto/elisp-json-rpc>
;; Entry points are the `transmission' and `transmission-add'
;; commands. A variety of commands are available for manipulating
;; torrents and their contents, some of which can be applied over
;; multiple items by selecting them within a region. The menus for
;; each context provide good exposure.
;; "M-x transmission RET" pops up a torrent list. One can add,
;; start/stop, verify, remove torrents, set speed limits, ratio
;; limits, bandwidth priorities, trackers, etc. Also, one can
;; navigate to the corresponding file list, torrent info, or peer info
;; contexts. In the file list, individual files can be toggled for
;; download, and their priorities set.
;; Customize-able are: the session address components, RPC
;; credentials, the display format of dates, file sizes and transfer
;; rates, pieces display, automatic refreshing of the torrent
;; list, etc. See the `transmission' customization group.
;; The design draws from a number of sources, including the command
;; line utility transmission-remote(1), the ncurses interface
;; transmission-remote-cli(1), and the rtorrent(1) client. These can
;; be found respectively at the following:
;; <https://trac.transmissionbt.com/browser/trunk/daemon/remote.c>
;; <https://github.com/fagga/transmission-remote-cli>
;; <https://rakshasa.github.io/rtorrent/>
;;; Code:
(require 'auth-source)
(require 'calc-bin)
(require 'calc-ext)
(require 'color)
(require 'json)
(require 'tabulated-list)
(require 'url-util)
(eval-when-compile
(require 'cl-lib)
(require 'let-alist)
(require 'subr-x))
(defgroup transmission nil
"Interface to a Transmission session."
:link '(url-link "https://trac.transmissionbt.com/")
:group 'external)
(defcustom transmission-host "localhost"
"Host name, IP address, or socket address of the Transmission session."
:type 'string)
(defcustom transmission-service 9091
"Port or name of the service for the Transmission session."
:type '(choice (const :tag "Default" 9091)
(string :tag "Service")
(integer :tag "Port")))
(defcustom transmission-rpc-path "/transmission/rpc"
"Path to the Transmission session RPC interface."
:type '(choice (const :tag "Default" "/transmission/rpc")
(string :tag "Other path")))
(defcustom transmission-rpc-auth nil
"Authentication (username, password, etc.) for the RPC interface.
Its value is a specification of the type used in `auth-source-search'.
If no password is set, `auth-sources' is searched using the
username, `transmission-host', and `transmission-service'."
:type '(choice (const :tag "None" nil)
(plist :tag "Username/password"
:options ((:username string)
(:password string))))
:link '(info-link "(auth) Help for users")
:link '(function-link auth-source-search))
(defcustom transmission-digit-delimiter ","
"String used to delimit digits in numbers.
The variable `calc-group-char' is bound to this in `transmission-group-digits'."
:type '(choice (const :tag "Comma" ",")
(const :tag "Full Stop" ".")
(const :tag "None" nil)
(string :tag "Other char"))
:link '(variable-link calc-group-char)
:link '(function-link transmission-group-digits))
(defcustom transmission-pieces-function #'transmission-format-pieces
"Function used to show pieces of incomplete torrents.
The function takes a string (bitfield) representing the torrent
pieces and the number of pieces as arguments, and should return a string."
:type '(radio (const :tag "None" nil)
(function-item transmission-format-pieces)
(function-item transmission-format-pieces-brief)
(function :tag "Function")))
(defcustom transmission-trackers '()
"List of tracker URLs.
These are used for completion in `transmission-trackers-add' and
`transmission-trackers-replace'."
:type '(repeat (string :tag "URL")))
(defcustom transmission-units nil
"The flavor of units used to display file sizes.
See `file-size-human-readable'."
:type '(choice (const :tag "Default" nil)
(const :tag "SI" si)
(const :tag "IEC" iec))
:link '(function-link file-size-human-readable))
(defcustom transmission-refresh-modes '()
"List of major modes in which to refresh the buffer automatically."
:type 'hook
:options '(transmission-mode
transmission-files-mode
transmission-info-mode
transmission-peers-mode))
(defcustom transmission-refresh-interval 2
"Period in seconds of the refresh timer."
:type '(number :validate (lambda (w)
(unless (> (widget-value w) 0)
(widget-put w :error "Value must be positive")
w))))
(defcustom transmission-time-format "%a %b %e %T %Y %z"
"Format string used to display dates.
See `format-time-string'."
:type 'string
:link '(function-link format-time-string))
(defcustom transmission-time-zone nil
"Time zone of formatted dates.
See `format-time-string'."
:type '(choice (const :tag "Local time" nil)
(const :tag "Universal Time (UTC)" t)
(const :tag "System Wall Clock" wall)
(string :tag "Time Zone Identifier"))
:link '(function-link format-time-string))
(defcustom transmission-torrent-functions '(transmission-ffap)
"List of functions to use for guessing torrents for `transmission-add'.
Each function should accept no arguments, and return a string or nil."
:type 'hook
:options '(transmission-ffap
transmission-ffap-selection
transmission-ffap-last-killed))
(defcustom transmission-geoip-function nil
"Function used to translate an IP address into a location name.
The function should accept an IP address and return a string or nil."
:type '(radio (const :tag "None" nil)
(function-item transmission-geoiplookup)
(function :tag "Function")))
(defcustom transmission-geoip-use-cache nil
"Whether to cache IP address/location name associations.
If non-nil, associations are stored in `transmission-geoip-hash'.
Useful if `transmission-geoip-function' does not have its own
caching built in or is otherwise slow."
:type 'boolean)
(defconst transmission-mode-alist
'((session . 0)
(torrent . 1)
(unlimited . 2))
"Alist of threshold mode enumerations.")
(defconst transmission-priority-alist
'((low . -1)
(normal . 0)
(high . 1))
"Alist of names to priority values.")
(defconst transmission-status-alist
'((stopped . 0)
(verifywait . 1)
(verifying . 2)
(downwait . 3)
(downloading . 4)
(seedwait . 5)
(seeding . 6))
"Alist of possible Transmission torrent statuses.")
(defconst transmission-torrent-get-fields
'("id" "name" "status" "eta" "error"
"rateDownload" "rateUpload"
"percentDone" "sizeWhenDone"
"uploadRatio"))
(defconst transmission-files-fields
'("name" "files" "fileStats" "downloadDir"))
(defconst transmission-info-fields
'("name" "hashString" "magnetLink" "activityDate" "addedDate"
"dateCreated" "doneDate" "startDate" "peers" "pieces" "pieceCount"
"pieceSize" "trackerStats" "peersConnected" "peersGettingFromUs" "peersFrom"
"peersSendingToUs" "sizeWhenDone" "error" "errorString" "uploadRatio"
"downloadedEver" "corruptEver" "haveValid" "totalSize" "percentDone"
"seedRatioLimit" "seedRatioMode" "bandwidthPriority" "downloadDir"
"uploadLimit" "uploadLimited" "downloadLimit" "downloadLimited"
"honorsSessionLimits"))
(defconst transmission-file-symbols
'(:files-wanted :files-unwanted :priority-high :priority-low :priority-normal)
"List of \"torrent-set\" method arguments for operating on files.")
(defconst transmission-session-header "X-Transmission-Session-Id"
"The \"X-Transmission-Session-Id\" header key.")
(defvar transmission-session-id nil
"The \"X-Transmission-Session-Id\" header value.")
(defvar-local transmission-torrent-vector nil
"Vector of Transmission torrent data.")
(defvar-local transmission-torrent-id nil
"The Transmission torrent ID integer.")
(defvar-local transmission-refresh-function nil
"The name of the function used to redraw a buffer.
Should accept the torrent ID as an argument, e.g. `transmission-torrent-id'.")
(define-error 'transmission-conflict
"Wrong or missing header \"X-Transmission-Session-Id\"")
(define-error 'transmission-unauthorized
"Unauthorized user. Check `transmission-rpc-auth'")
(define-error 'transmission-wrong-rpc-path
"Bad RPC path. Check `transmission-rpc-path'")
(defvar transmission-timer nil
"Timer for repeating `revert-buffer' in a visible Transmission buffer.")
(defconst transmission-hash-table (make-hash-table :test 'equal)
"Hash table used as initial value of `transmission-geoip-hash'.")
(defvar transmission-geoip-hash (copy-hash-table transmission-hash-table)
"Hash table storing associations between IP addresses and location names.")
;; JSON RPC
(defun transmission--move-to-content ()
"Move the point to beginning of content after the headers."
(setf (point) (point-min))
(re-search-forward "\r?\n\r?\n" nil t))
(defun transmission--content-finished-p ()
"Return non-nil if all of the content has arrived."
(setf (point) (point-min))
(when (search-forward "Content-Length: " nil t)
(let ((length (read (current-buffer))))
(and (transmission--move-to-content)
(<= length (- (position-bytes (point-max))
(position-bytes (point))))))))
(defun transmission--status ()
"Check the HTTP status code.
A 409 response from a Transmission session includes the
\"X-Transmission-Session-Id\" header. If a 409 is received,
update `transmission-session-id' and signal the error."
(save-excursion
(goto-char (point-min))
(skip-chars-forward "HTTP/")
(skip-chars-forward "[0-9].")
(let* ((buffer (current-buffer))
(status (read buffer)))
(pcase status
((or 301 404 405) (signal 'transmission-wrong-rpc-path status))
(401 (signal 'transmission-unauthorized status))
(409 (when (search-forward (format "%s: " transmission-session-header))
(setq transmission-session-id (read buffer))
(signal 'transmission-conflict status)))))))
(defun transmission--auth-source-secret (user)
"Return the secret for USER at found in `auth-sources'.
Unless otherwise specified in `transmission-rpc-auth', the host
and port default to `transmission-host' and
`transmission-service', respectively."
(let ((spec (copy-sequence transmission-rpc-auth)))
(unless (plist-get spec :host) (plist-put spec :host transmission-host))
(unless (plist-get spec :port) (plist-put spec :port transmission-service))
(apply #'auth-source-pick-first-password (nconc `(:user ,user) spec))))
(defun transmission--auth-string ()
"HTTP \"Authorization\" header value if `transmission-rpc-auth' is populated."
(when transmission-rpc-auth
(let* ((user (plist-get transmission-rpc-auth :username))
(pass (and user (or (plist-get transmission-rpc-auth :password)
(transmission--auth-source-secret user)))))
(concat "Basic " (base64-encode-string (concat user ":" pass))))))
(defun transmission-http-post (process content)
"Send to PROCESS an HTTP POST request containing CONTENT."
(with-current-buffer (process-buffer process)
(erase-buffer))
(let ((headers (list (cons transmission-session-header transmission-session-id)
(cons "Content-length" (string-bytes content)))))
(let ((auth (transmission--auth-string)))
(if auth (push (cons "Authorization" auth) headers)))
(with-temp-buffer
(insert (format "POST %s HTTP/1.1\r\n" transmission-rpc-path))
(mapc (lambda (elt)
(insert (format "%s: %s\r\n" (car elt) (cdr elt))))
headers)
(insert "\r\n" content)
(process-send-string process (buffer-string)))))
(defun transmission-wait (process)
"Wait to receive HTTP response from PROCESS.
Return JSON object parsed from content."
(with-current-buffer (process-buffer process)
(while (and (not (transmission--content-finished-p))
(process-live-p process))
(accept-process-output process 1))
(transmission--status)
(transmission--move-to-content)
(json-read)))
(defun transmission-send (process content)
"Send PROCESS string CONTENT and wait for response synchronously."
(transmission-http-post process content)
(transmission-wait process))
(defun transmission-make-network-process ()
"Return a network client process connected to a transmission daemon.
When creating a new connection, the address is determined by the
custom variables `transmission-host' and `transmission-service'."
(let ((socket (if (file-name-absolute-p transmission-host)
(expand-file-name transmission-host))))
(make-network-process
:name "transmission" :buffer (generate-new-buffer " *transmission*")
:host (unless socket transmission-host)
:service (or socket transmission-service)
:family (if socket 'local))))
(defun transmission-request (method &optional arguments tag)
"Send a request to Transmission.
METHOD is a string.
ARGUMENTS is a plist having keys corresponding to METHOD.
TAG is an integer and ignored.
Details regarding the Transmission RPC can be found here:
<https://trac.transmissionbt.com/browser/trunk/extras/rpc-spec.txt>"
(let ((process (transmission-make-network-process))
(content (json-encode `(:method ,method :arguments ,arguments :tag ,tag))))
(unwind-protect
(condition-case nil
(transmission-send process content)
(transmission-conflict
(transmission-send process content)))
(when (process-live-p process)
(delete-process process)
(kill-buffer (process-buffer process))))))
;; Asynchronous calls
(defun transmission-process-filter (process _string)
"Function used as a supplement to the default filter function for PROCESS."
(when (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
(when (transmission--content-finished-p)
(condition-case e
(progn (transmission--status)
(delete-process process))
(transmission-conflict
(let ((content (process-get process :request)))
(transmission-http-post process content)))
(error
(process-put process :callback nil)
(delete-process process)
(message "%s" (error-message-string e))))))))
(defun transmission-process-sentinel (process _message)
"Dispatch callback function for PROCESS and kill the process buffer."
(when (buffer-live-p (process-buffer process))
(unwind-protect
(let* ((callback (process-get process :callback))
(content (and callback
(with-current-buffer (process-buffer process)
(transmission--move-to-content)
(buffer-substring (point) (point-max))))))
(if callback (run-at-time 0 nil callback content)))
(kill-buffer (process-buffer process)))))
(defun transmission-request-async (callback method &optional arguments tag)
"Send a request to Transmission asynchronously.
CALLBACK accepts one argument, the HTTP response content.
METHOD, ARGUMENTS, and TAG are the same as in `transmission-request'."
(let ((process (transmission-make-network-process))
(content (json-encode `(:method ,method :arguments ,arguments :tag ,tag))))
(set-process-sentinel process #'transmission-process-sentinel)
(add-function :after (process-filter process) 'transmission-process-filter)
(process-put process :request content)
(process-put process :callback callback)
(transmission-http-post process content)
process))
;; Response parsing
(defun transmission-torrents (response)
"Return the \"torrents\" array in RESPONSE.
Each element is an alist with keys corresponding to the elements
of \"fields\" in the arguments of the \"torrent-get\" request."
(cdr (assq 'torrents (cdr (assq 'arguments response)))))
;; Timer management
(defun transmission-timer-revert ()
"Revert the buffer or cancel `transmission-timer'."
(if (and (memq major-mode transmission-refresh-modes)
(not (or isearch-mode (use-region-p))))
(revert-buffer)
(cancel-timer transmission-timer)))
(defun transmission-timer-run ()
"Run the timer `transmission-timer'."
(when transmission-timer (cancel-timer transmission-timer))
(setq
transmission-timer
(run-at-time t transmission-refresh-interval #'transmission-timer-revert)))
(defun transmission-timer-check ()
"Check if current buffer should run a refresh timer."
(when (memq major-mode transmission-refresh-modes)
(transmission-timer-run)))
;; Other
(defun transmission-refs (sequence key)
"Make a list of the values of KEY in each element of SEQUENCE."
(mapcar (lambda (x) (cdr (assq key x))) sequence))
(defun transmission-size (bytes)
"Return string showing size BYTES in human-readable form."
(file-size-human-readable bytes transmission-units))
(defun transmission-percent (have total)
"Return the percentage of HAVE by TOTAL."
(condition-case nil
(/ (* 100.0 have) total)
(arith-error 0)))
(defun transmission-files-directory-base (filename)
"Return the top-most parent directory in string FILENAME."
(let ((index (and (stringp filename)
(string-match-p "/" filename))))
(if index (substring filename 0 (1+ index)))))
(defun transmission-every-prefix-p (prefix list)
"Return t if PREFIX is a prefix to every string in LIST, otherwise nil."
(not (cl-loop for string in list
if (not (string-prefix-p prefix string)) return t)))
(defun transmission-slice (str k)
"Slice STRING into K strings of somewhat equal size.
The result can have no more elements than STRING."
(let ((len (length str)))
(let ((quotient (/ len k))
(remainder (% len k))
(i 0)
slice result)
(while (and (/= 0 (setq len (length str))) (< i k))
(setq slice (if (< i remainder) (1+ quotient) quotient))
(push (substring str 0 (min slice len)) result)
(setq str (substring str (min slice len) len))
(cl-incf i))
(nreverse result))))
(defun transmission-prop-values-in-region (prop)
"Return a list of truthy values of text property PROP in region or at point.
If none are found, return nil."
(if (use-region-p)
(let ((beg (region-beginning))
(end (region-end))
(list '()))
(save-excursion
(goto-char beg)
(while (> end (point))
(push (get-text-property (point) prop) list)
(let ((pos (text-property-not-all (point) end prop (car-safe list))))
(goto-char (or pos end)))))
(and (car-safe list) list))
(let ((value (get-text-property (point) prop)))
(if value (list value)))))
(defun transmission-eta (seconds percent)
"Return a string showing SECONDS in human-readable form;
otherwise some other estimate indicated by SECONDS and PERCENT."
(if (<= seconds 0)
(pcase percent
(1 "Done")
(_ (if (char-displayable-p ?∞) (eval-when-compile (char-to-string ?∞)) "Inf")))
(let* ((minute 60.0)
(hour 3600.0)
(day 86400.0)
(month (* 29.53 day))
(year (* 365.25 day)))
(apply #'format "%.0f%s"
(pcase seconds
((pred (> minute)) (list seconds "s"))
((pred (> hour)) (list (/ seconds minute) "m"))
((pred (> day)) (list (/ seconds hour) "h"))
((pred (> month)) (list (/ seconds day) "d"))
((pred (> year)) (list (/ seconds month) "mo"))
(_ (list (/ seconds year) "y")))))))
(defun transmission-when (seconds)
"The `transmission-eta' of time between `current-time' and SECONDS."
(if (<= seconds 0) "never"
(let ((secs (- seconds (time-to-seconds (current-time)))))
(format (if (< secs 0) "%s ago" "in %s")
(transmission-eta (abs secs) nil)))))
(defun transmission-rate (bytes)
"Return a rate in units kilobytes per second.
The rate is calculated from BYTES according to `transmission-units'."
(/ bytes (if (eq 'iec transmission-units) 1024 1000)))
(defun transmission-throttle-torrent (ids limit n)
"Set transfer speed limit for IDS.
LIMIT is a symbol; either uploadLimit or downloadLimit.
N is the desired threshold. A negative value of N means to disable the limit."
(cl-assert (memq limit '(uploadLimit downloadLimit)))
(let* ((limit (intern (concat ":" (symbol-name limit))))
(limited (intern (concat (symbol-name limit) "ed")))
(arguments `(:ids ,ids ,@(if (< n 0) `(,limited :json-false)
`(,limited t ,limit ,n)))))
(transmission-request-async nil "torrent-set" arguments)))
(defun transmission-set-torrent-speed-limit (ids d)
"Set speed limit of torrents IDS.
Direction D should be a symbol, either \"up\" or \"down\"."
(cl-assert (memq d '(up down)))
(let* ((str (concat (symbol-name d) "loadLimit"))
(limit (intern str))
(limited (intern (concat str "ed"))))
(if (cdr ids)
(let ((prompt (concat "Set torrents' " (symbol-name d) "load limit: ")))
(transmission-throttle-torrent ids limit (read-number prompt)))
(transmission-request-async
(lambda (content)
(let* ((torrents (transmission-torrents (json-read-from-string content)))
(torrent (elt torrents 0))
(n (cdr (assq limit torrent)))
(throttle (eq t (cdr (assq limited torrent))))
(prompt (concat "Set torrent's " (symbol-name d) "load limit ("
(if throttle (format "%d kB/s" n) "disabled") "): ")))
(transmission-throttle-torrent ids limit (read-number prompt))))
"torrent-get" `(:ids ,ids :fields (,str ,(concat str "ed")))))))
(defun transmission-prompt-speed-limit (upload)
"Make a prompt to set transfer speed limit.
If UPLOAD is non-nil, make a prompt for upload rate, otherwise
for download rate."
(let-alist (transmission-request "session-get")
(let ((limit (if upload .arguments.speed-limit-up
.arguments.speed-limit-down))
(enabled (eq t (if upload .arguments.speed-limit-up-enabled
.arguments.speed-limit-down-enabled))))
(list (read-number (concat "Set global " (if upload "up" "down") "load limit ("
(if enabled (format "%d kB/s" limit) "disabled")
"): "))))))
(defun transmission-prompt-ratio-limit ()
"Make a prompt to set global seed ratio limit."
(let-alist (transmission-request "session-get")
(let ((limit .arguments.seedRatioLimit)
(enabled (eq t .arguments.seedRatioLimited)))
(list (read-number (concat "Set global seed ratio limit ("
(if enabled (format "%.1f" limit) "disabled")
"): "))))))
(defun transmission-read-strings (prompt &optional collection)
"Read strings until an input is blank, with optional completion.
PROMPT and COLLECTION are the same as in `completing-read'.
Returns a list of non-blank inputs."
(let (res entry)
(catch :finished
(while t
(setq entry (if (not collection) (read-string prompt)
(completing-read prompt collection nil)))
(if (and (not (string-empty-p entry))
(not (string-blank-p entry)))
(progn (push entry res)
(setq collection (delete entry collection)))
(throw :finished (nreverse res)))))))
(defun transmission-list-trackers (id)
"Return the \"trackerStats\" array for torrent id ID."
(let* ((arguments `(:ids ,id :fields ("trackerStats")))
(response (transmission-request "torrent-get" arguments))
(torrents (transmission-torrents response)))
(cdr (assq 'trackerStats (elt torrents 0)))))
(defun transmission-list-unique-announce-urls ()
"Return a list of unique announce URLs from all current torrents."
(let* ((response (transmission-request "torrent-get" '(:fields ("trackers"))))
(trackers (transmission-refs (transmission-torrents response) 'trackers))
(urls (mapcar (lambda (vector) (transmission-refs vector 'announce))
trackers)))
(delete-dups (apply #'append (delq nil urls)))))
(defun transmission-btih-p (string)
"Return non-nil if STRING is a BitTorrent info hash, otherwise nil."
(if (and string (string-match-p "\\`[[:xdigit:]]\\{40\\}\\'" string)) string))
(defun transmission-directory-name-p (name)
"Return non-nil if NAME ends with a directory separator character."
(let ((len (length name))
(last ?.))
(if (> len 0) (setq last (aref name (1- len))))
(or (= last ?/)
(and (memq system-type '(windows-nt ms-dos))
(= last ?\\)))))
(defun transmission-ffap ()
"Return a file name, URL, or info hash at point, otherwise nil."
(or (get-text-property (point) 'shr-url)
(get-text-property (point) :nt-link)
(let ((fn (or (ffap-guess-file-name-at-point)
(if (fboundp 'dired-file-name-at-point)
(dired-file-name-at-point)))))
(unless (transmission-directory-name-p fn) fn))
(url-get-url-at-point)
(transmission-btih-p (thing-at-point 'word))))
(defun transmission-ffap-string (string)
"Apply `transmission-ffap' to the beginning of STRING."
(when string
(with-temp-buffer
(insert string)
(goto-char (point-min))
(transmission-ffap))))
(defun transmission-ffap-last-killed ()
"Apply `transmission-ffap' to the most recent `kill-ring' entry."
(transmission-ffap-string (car kill-ring)))
(defun transmission-ffap-selection ()
"Apply `transmission-ffap' to the graphical selection."
(transmission-ffap-string (with-no-warnings (x-get-selection))))
(defun transmission-files-do (action)
"Apply ACTION to files in `transmission-files-mode' buffers."
(cl-assert (memq action transmission-file-symbols))
(let ((id transmission-torrent-id)
(indices (mapcar (lambda (id) (cdr (assq 'index id)))
(transmission-prop-values-in-region 'tabulated-list-id))))
(if (and id indices)
(let ((arguments (list :ids id action indices)))
(transmission-request-async nil "torrent-set" arguments))
(user-error "No files selected or at point"))))
(defun transmission-files-file-at-point ()
"Return the absolute path of the torrent file at point, or nil.
If the file named \"foo\" does not exist, try \"foo.part\" before returning."
(let* ((dir (file-name-as-directory
(cdr (assq 'downloadDir (elt transmission-torrent-vector 0)))))
(base (cdr (assq 'name (tabulated-list-get-id))))
(full (and dir base (concat dir base))))
(if full
(or (and (file-exists-p full) full)
(and (file-exists-p (concat full ".part"))
(concat full ".part")))
(user-error "No file at point"))))
(defun transmission-files-sort (torrent)
"Return a list derived from the \"files\" and \"fileStats\" arrays in TORRENT.
The two are spliced together with indices for each file, sorted by file name."
(let* ((alist (elt torrent 0))
(files (cdr (assq 'files alist)))
(stats (cdr (assq 'fileStats alist))))
(sort (cl-loop for f across files
for s across stats
for i below (length files)
collect (append f s (list (cons 'index i))))
(lambda (a b)
(string< (cdr (assq 'name a))
(cdr (assq 'name b)))))))
(defun transmission-geoiplookup (ip)
"Return country name associated with IP using geoiplookup(1)."
(let ((program (if (string-match-p ":" ip) "geoiplookup6" "geoiplookup")))
(when (executable-find program)
(with-temp-buffer
(call-process program nil t nil ip)
(car (last (split-string (buffer-string) ": " t "[ \t\r\n]*")))))))
(defun transmission-geoip-retrieve (ip)
"Retrieve value of IP in `transmission-geoip-hash'.
If IP is not a key, add it with the value from `transmission-geoip-function'.
If `transmission-geoip-function' has changed, reset `transmission-geoip-hash'
from `transmission-hash-table'."
(when (functionp transmission-geoip-function)
(if (not transmission-geoip-use-cache)
(funcall transmission-geoip-function ip)
(let ((fn (get 'transmission-geoip-hash :fn)))
(if (eq fn transmission-geoip-function)
(or (gethash ip transmission-geoip-hash)
(setf (gethash ip transmission-geoip-hash)
(funcall transmission-geoip-function ip)))
(setq transmission-geoip-hash
(copy-hash-table transmission-hash-table))
(put 'transmission-geoip-hash :fn transmission-geoip-function)
(setf (gethash ip transmission-geoip-hash)
(funcall transmission-geoip-function ip)))))))
(defun transmission-time (seconds)
"Format a time string, given SECONDS from the epoch."
(if (= 0 seconds) "Never"
(format-time-string transmission-time-format (seconds-to-time seconds)
transmission-time-zone)))
(defun transmission-hamming-weight (x)
"Calculate the Hamming weight of X."
(let ((m1 #x555555555555555)
(m2 #x333333333333333)
(m4 #x0f0f0f0f0f0f0f0f)
(h01 #x0101010101010101))
(setq x (- x (logand (lsh x -1) m1)))
(setq x (+ (logand x m2) (logand (lsh x -2) m2)))
(setq x (logand (+ x (lsh x -4)) m4))
(lsh (* x h01) -56)))
(defun transmission-count-bits (bytearray)
"Calculate sum of Hamming weight of each byte in BYTEARRAY."
(cl-loop for x across bytearray sum (transmission-hamming-weight x)))
(defun transmission-byte->string (byte)
"Format integer BYTE into a string."
(let* ((calc-number-radix 2)
(string (math-format-binary byte)))
(concat (make-string (- 8 (length string)) ?0) string)))
(defun transmission-ratio->glyph (ratio)
"Return a single-char string representing RATIO."
(char-to-string
(cond
((= 0 ratio) #x20)
((< ratio 0.333) #x2591)
((< ratio 0.667) #x2592)
((< ratio 1) #x2593)
((= 1 ratio) #x2588))))
(defun transmission-ratio->256 (ratio)
"Return a grey font-locked single-space string according to RATIO.
Uses color names for the 256 color palette."
(let ((n (if (= 1 ratio) 231 (+ 236 (* 19 ratio)))))
(propertize " " 'font-lock-face `(:background ,(format "color-%d" n)))))
(defun transmission-ratio->grey (ratio)
"Return a grey font-locked single-space string according to RATIO."
(let ((l (+ 0.2 (* 0.8 ratio))))
(propertize " " 'font-lock-face `(:background ,(color-rgb-to-hex l l l))
'help-echo (format "%.2f" ratio))))
(defun transmission-torrent-seed-ratio (mode tlimit)
"String showing a torrent's seed ratio limit.
MODE is which seed ratio to use; TLIMIT is the torrent-level limit."
(pcase mode
(0 "session limit")
(1 (format "%.2f (torrent-specific limit)" tlimit))
(2 "unlimited")))
(defun transmission-group-digits (n)
"Group digits of positive number N with `transmission-digit-delimiter''"
(if (< n 10000) (number-to-string n)
(let ((calc-group-char transmission-digit-delimiter))
(math-group-float (number-to-string n)))))
(defun transmission-plural (n s)
"Return a pluralized string expressing quantity N of thing S.
Done in the spirit of `dired-plural-s'."
(let ((m (if (= -1 n) 0 n)))
(concat (transmission-group-digits m) " " s (unless (= m 1) "s"))))
(defun transmission-format-rate (bytes throttled)
"Format BYTES per second into a string with units."
(if (not (eq t throttled)) "unlimited"
(concat (transmission-group-digits bytes) " kB/s")))
(defun transmission-format-size (bytes)
"Format size BYTES into a more readable string."
(format "%s (%s bytes)" (transmission-size bytes)
(transmission-group-digits bytes)))
(defmacro transmission-tabulated-list-pred (key)
"Return a sorting predicate comparing values of KEY.
KEY should be a key in an element of `tabulated-list-entries'."
(declare (debug t))
`(lambda (a b)
(> (cdr (assq ,key (car a)))
(cdr (assq ,key (car b))))))
(defmacro transmission-let*-ids (bindings &rest body)
"Conditionally bind variables according to BINDINGS and eval BODY.
If anaphoric binding of \"ids\"--to the list of torrent IDs at
point or in region--is non-nil, then BINDINGS and BODY are fed to
`let*'. Else, a `user-error' is signalled."
(declare (indent 1) (debug t))
`(let ((ids (or (and transmission-torrent-id (list transmission-torrent-id))
(mapcar (lambda (id) (cdr (assq 'id id)))
(transmission-prop-values-in-region 'tabulated-list-id)))))
(if ids
(let* (,@bindings)
,@body)
(user-error "No torrent selected"))))
;; Interactive
;;;###autoload
(defun transmission-add (torrent &optional directory)
"Add TORRENT by filename, URL, magnet link, or info hash.
When called with a prefix, prompt for DIRECTORY."
(interactive
(let* ((def (run-hook-with-args-until-success 'transmission-torrent-functions))
(prompt (concat "Add torrent" (if def (format " [%s]" def)) ": ")))
(list (read-file-name prompt nil def)
(if current-prefix-arg
(read-directory-name "Target directory: ")))))
(transmission-request-async
(lambda (content)
(let-alist (json-read-from-string content)
(pcase .result
("success"
(or (and .arguments.torrent-added.name
(message "Added %s" .arguments.torrent-added.name))
(and .arguments.torrent-duplicate.name
(message "Already added %s" .arguments.torrent-duplicate.name))))
(_ (message .result)))))
"torrent-add"
(append (if (and (file-readable-p torrent) (not (file-directory-p torrent)))
`(:metainfo ,(with-temp-buffer
(insert-file-contents torrent)
(base64-encode-string (buffer-string))))
(setq torrent (string-trim torrent))
`(:filename ,(if (transmission-btih-p torrent)
(format "magnet:?xt=urn:btih:%s" torrent)
torrent)))
(if directory (list :download-dir (expand-file-name directory))))))
(defun transmission-move (location)
"Move torrent at point or in region to a new LOCATION."
(interactive (list (read-directory-name "New directory: ")))
(transmission-let*-ids
((arguments (list :ids ids :move t :location (expand-file-name location)))
(prompt (format "Move torrent%s to %s? " (if (cdr ids) "s" "") location)))
(when (y-or-n-p prompt)
(transmission-request-async nil "torrent-set-location" arguments))))
(defun transmission-reannounce ()
"Reannounce torrent at point or in region."
(interactive)
(transmission-let*-ids nil
(transmission-request-async nil "torrent-reannounce" (list :ids ids))))
(defun transmission-remove (&optional unlink)
"Prompt to remove torrent at point or torrents in region.
When called with a prefix UNLINK, also unlink torrent data on disk."
(interactive "P")
(transmission-let*-ids ((arguments `(:ids ,ids :delete-local-data ,(and unlink t))))
(when (yes-or-no-p (concat "Remove " (and unlink "and unlink ")
"torrent" (and (< 1 (length ids)) "s") "? "))
(transmission-request-async nil "torrent-remove" arguments))))
(defun transmission-set-bandwidth-priority ()
"Set bandwidth priority of torrent(s) at point or in region."
(interactive)
(transmission-let*-ids
((prompt "Set bandwidth priority: ")
(priority (completing-read prompt transmission-priority-alist nil t))
(number (cdr (assoc-string priority transmission-priority-alist)))
(arguments `(:ids ,ids :bandwidthPriority ,number)))
(transmission-request-async nil "torrent-set" arguments)))
(defun transmission-set-download (limit)
"Set global download speed LIMIT in kB/s."
(interactive (transmission-prompt-speed-limit nil))
(let ((arguments (if (<= limit 0) '(:speed-limit-down-enabled :json-false)
`(:speed-limit-down-enabled t :speed-limit-down ,limit))))
(transmission-request-async nil "session-set" arguments)))
(defun transmission-set-upload (limit)
"Set global upload speed LIMIT in kB/s."
(interactive (transmission-prompt-speed-limit t))
(let ((arguments (if (< limit 0) '(:speed-limit-up-enabled :json-false)
`(:speed-limit-up-enabled t :speed-limit-up ,limit))))
(transmission-request-async nil "session-set" arguments)))
(defun transmission-set-ratio (limit)
"Set global seed ratio LIMIT."
(interactive (transmission-prompt-ratio-limit))
(let ((arguments (if (< limit 0) '(:seedRatioLimited :json-false)
`(:seedRatioLimited t :seedRatioLimit ,limit))))
(transmission-request-async nil "session-set" arguments)))
(defun transmission-set-torrent-download ()
"Set download limit of torrent(s) at point in kB/s."
(interactive)
(transmission-let*-ids nil
(transmission-set-torrent-speed-limit ids 'down)))
(defun transmission-set-torrent-upload ()
"Set upload limit of torrent(s) at point in kB/s."
(interactive)
(transmission-let*-ids nil
(transmission-set-torrent-speed-limit ids 'up)))
(defun transmission-set-torrent-ratio ()
"Set seed ratio limit of torrent(s) at point."
(interactive)
(transmission-let*-ids
((prompt (concat "Set torrent" (if (cdr ids) "s'" "'s") " ratio mode: "))
(mode (completing-read prompt transmission-mode-alist nil t))
(n (cdr (assoc-string mode transmission-mode-alist)))
(arguments `(:ids ,ids :seedRatioMode ,n)))
(when (= n 1)
(let ((limit (read-number "Set torrent ratio limit: ")))
(setq arguments (append arguments `(:seedRatioLimit ,limit)))))
(transmission-request-async nil "torrent-set" arguments)))
(defun transmission-toggle-limits ()
"Toggle whether torrent(s) at point honor session speed limits."
(interactive)
(transmission-let*-ids nil
(transmission-request-async
(lambda (content)
(let* ((torrents (transmission-torrents (json-read-from-string content)))
(honor (pcase (cdr (assq 'honorsSessionLimits (elt torrents 0)))
(:json-false t) (_ :json-false))))
(transmission-request-async nil "torrent-set"
`(:ids ,ids :honorsSessionLimits ,honor))))
"torrent-get" `(:ids ,ids :fields ("honorsSessionLimits")))))
(defun transmission-toggle ()
"Toggle torrent between started and stopped."
(interactive)
(transmission-let*-ids nil
(transmission-request-async
(lambda (content)
(let* ((torrents (transmission-torrents (json-read-from-string content)))
(status (cdr (assq 'status (elt torrents 0))))
(method (pcase status (0 "torrent-start") (_ "torrent-stop"))))
(transmission-request-async nil method (list :ids ids))))
"torrent-get" (list :ids ids :fields '("status")))))
(defun transmission-trackers-add ()
"Add announce URLs to torrent or torrents."
(interactive)
(transmission-let*-ids
((trackers (transmission-refs (transmission-list-trackers ids) 'announce))
(urls (or (transmission-read-strings
"Add announce URLs: "
(cl-loop for url in
(append transmission-trackers
(transmission-list-unique-announce-urls))
unless (member url trackers) collect url))
(user-error "No trackers to add")))
(arguments (list :ids ids :trackerAdd
;; Don't add trackers that are already there
(cl-loop for url in urls
unless (member url trackers) collect url))))
(transmission-request-async
(lambda (content)