forked from holomorph/transmission
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtransmission.el
2422 lines (2170 loc) · 103 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-2021 Mark Oteiza <[email protected]>
;; Author: Mark Oteiza <[email protected]>
;; Version: 0.12.2
;; Package-Requires: ((emacs "24.4") (let-alist "1.0.5"))
;; 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.
;; Entry points are the `transmission' and `transmission-add'
;; commands. A variety of commands are available for manipulating
;; torrents and their contents, many of which can be applied over
;; multiple items by selecting them with marks or 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://github.com/transmission/transmission/blob/master/utils/remote.c>
;; <https://github.com/fagga/transmission-remote-cli>
;; <https://rakshasa.github.io/rtorrent/>
;; Originally based on the JSON RPC library written by Christopher
;; Wellons, available online at <https://github.com/skeeto/elisp-json-rpc>.
;;; Code:
(require 'auth-source)
(require 'calc-bin)
(require 'calc-ext)
(require 'color)
(require 'diary-lib)
(require 'json)
(require 'mailcap)
(require 'tabulated-list)
(require 'url-util)
(eval-when-compile
(cl-declaim (optimize (speed 3)))
(require 'cl-lib)
(require 'let-alist)
(require 'subr-x))
(declare-function dired-goto-file "dired" (file))
(defgroup transmission nil
"Interface to a Transmission session."
:link '(url-link "https://github.com/transmission/transmission")
:link '(url-link "https://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"))
:link '(function-link make-network-process))
(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)
(when (<= (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 '(info-link "(libc) TZ Variable")
:link '(function-link format-time-string))
(defcustom transmission-add-history-variable 'transmission-add-history
"History list to use for interactive prompts of `transmission-add'.
Consider adding the value (`transmission-add-history' by default)
to `savehist-additional-variables'."
:type 'variable
:link '(emacs-commentary-link "savehist"))
(defcustom transmission-tracker-history-variable 'transmission-tracker-history
"History list to use for interactive prompts of tracker commands.
Consider adding the value (`transmission-tracker-history' by default)
to `savehist-additional-variables'."
:type 'variable
:link '(emacs-commentary-link "savehist"))
(defcustom transmission-torrent-functions
'(transmission-ffap transmission-ffap-selection transmission-ffap-last-killed)
"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-files-command-functions '(mailcap-file-default-commands)
"List of functions to use for guessing default applications.
Each function should accept one argument, a list of file names,
and return a list of strings or nil."
:type 'hook
:options '(mailcap-file-default-commands))
(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-table'.
Useful if `transmission-geoip-function' does not have its own
caching built in or is otherwise slow."
:type 'boolean)
(defcustom transmission-turtle-lighter " turtle"
"Lighter for `transmission-turtle-mode'."
:type '(choice (const :tag "Default" " turtle")
(const :tag "ASCII" " ,=,e")
(const :tag "Emoji" " \U0001f422")
(string :tag "Some string"))
:set (lambda (symbol value)
(set-default symbol value)
(when (fboundp 'transmission-turtle-poll) (transmission-turtle-poll)))
:link '(info-link "(elisp) Defining Minor Modes"))
(defconst transmission-schedules
(eval-when-compile
(pcase-let*
((`(,sun ,mon ,tues ,wed ,thurs ,fri ,sat)
(cl-loop for x below 7 collect (lsh 1 x)))
(weekday (logior mon tues wed thurs fri))
(weekend (logior sat sun))
(all (logior weekday weekend)))
`((sun . ,sun)
(mon . ,mon)
(tues . ,tues)
(wed . ,wed)
(thurs . ,thurs)
(fri . ,fri)
(sat . ,sat)
(weekday . ,weekday)
(weekend . ,weekend)
(all . ,all))))
"Alist of Transmission turtle mode schedules.")
(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-names
["stopped"
"verifywait"
"verifying"
"downwait"
"downloading"
"seedwait"
"seeding"]
"Array of possible Transmission torrent statuses.")
(defconst transmission-draw-torrents-keys
["hashString" "name" "status" "eta" "error" "labels"
"rateDownload" "rateUpload"
"percentDone" "sizeWhenDone" "metadataPercentComplete"
"uploadRatio"])
(defconst transmission-draw-files-keys
["name" "files" "downloadDir" "wanted" "priorities"])
(defconst transmission-draw-info-keys
["id" "name" "hashString" "magnetLink" "labels" "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" "rateDownload" "rateUpload" "queuePosition"])
(defconst transmission-file-symbols
'(:files-wanted :files-unwanted :priority-high :priority-low :priority-normal)
"List of \"torrent-set\" method arguments for operating on files.")
(defvar transmission-session-id nil
"The \"X-Transmission-Session-Id\" header value.")
(defvar transmission-add-history nil
"Default history list for `transmission-add'.")
(defvar transmission-tracker-history nil
"Default history list for `transmission-trackers-add' and others.")
(defvar-local transmission-torrent-vector nil
"Vector of Transmission torrent data.")
(defvar-local transmission-torrent-id nil
"The SHA-1 torrent info hash.")
(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'")
(define-error 'transmission-failure "RPC Failure")
(define-error 'transmission-misdirected
"Unrecognized hostname. Check \"rpc-host-whitelist\"")
(defvar transmission-timer nil
"Timer for repeating `revert-buffer' in a visible Transmission buffer.")
(defvar transmission-geoip-table (make-hash-table :test 'equal)
"Table for storing associations between IP addresses and location names.")
(defvar-local transmission-marked-ids nil
"List of identifiers of the currently marked items.")
(defvar transmission-network-process-pool nil
"List of network processes connected to Transmission.")
;; 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" 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."
(goto-char (point-min))
(forward-char 5) ; skip "HTTP/"
(skip-chars-forward "0-9.")
(let* ((buffer (current-buffer))
(status (read buffer)))
(pcase status
(200 (let (result)
(when (and (transmission--move-to-content)
(search-forward "\"result\":" nil t)
(not (equal "success" (setq result (json-read)))))
(signal 'transmission-failure (list result)))))
((or 301 404 405) (signal 'transmission-wrong-rpc-path (list status)))
(401 (signal 'transmission-unauthorized (list status)))
(403 (signal 'transmission-failure (list status)))
(409 (when (search-forward "X-Transmission-Session-Id: ")
(setq transmission-session-id (read buffer))
(signal 'transmission-conflict (list status))))
(421 (signal 'transmission-misdirected (list transmission-host))))))
(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) t)))))
(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 "X-Transmission-Session-Id" transmission-session-id)
(cons "Host" transmission-host) ; CVE-2018-5702
(cons "Content-length" (string-bytes content)))))
(let ((auth (transmission--auth-string)))
(when auth (push (cons "Authorization" auth) headers)))
(with-temp-buffer
(insert (concat "POST " transmission-rpc-path " HTTP/1.1\r\n"))
(dolist (elt headers)
(insert (format "%s: %s\r\n" (car elt) (cdr elt))))
(insert "\r\n" content)
(process-send-region process (point-min) (point-max)))))
(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)
(when (search-forward "\"arguments\":" nil t)
(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-process-sentinel (process _message)
"Sentinel for PROCESS made by `transmission-make-network-process'."
(setq transmission-network-process-pool
(delq process transmission-network-process-pool))
(when (buffer-live-p (process-buffer process))
(kill-buffer (process-buffer 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 (when (file-name-absolute-p transmission-host)
(expand-file-name transmission-host)))
buffer process)
(unwind-protect
(prog1
(setq buffer (generate-new-buffer " *transmission*")
process
(make-network-process
:name "transmission" :buffer buffer
:host (when (null socket) transmission-host)
:service (or socket transmission-service)
:family (when socket 'local) :noquery t
:coding 'binary :filter-multibyte nil))
(setq buffer nil process nil))
(when (process-live-p process) (kill-process process))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(defun transmission-get-network-process ()
"Return a network client process connected to a Transmission daemon.
Returns a stopped process in `transmission-network-process-pool'
or, if none is found, establishes a new connection and adds it to
the pool."
(or (cl-loop for process in transmission-network-process-pool
when (process-command process) return (continue-process process))
(let ((process (transmission-make-network-process)))
(push process transmission-network-process-pool)
process)))
(defun transmission-request (method &optional arguments tag)
"Send a request to Transmission and return a JSON object.
The JSON is the \"arguments\" object decoded Transmission's response.
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://github.com/transmission/transmission/blob/master/extras/rpc-spec.txt>"
(let ((process (transmission-get-network-process))
(content (json-encode `(:method ,method :arguments ,arguments :tag ,tag))))
(set-process-plist process nil)
(set-process-filter process nil)
(set-process-sentinel process nil)
(unwind-protect
(condition-case err
(transmission-send process content)
(transmission-conflict
(transmission-send process content))
(transmission-failure
(message "%s" (cdr err))))
(if (process-live-p process) (stop-process process)
(setq transmission-network-process-pool
(delq process transmission-network-process-pool))
(kill-buffer (process-buffer process))))))
;; Asynchronous calls
(defun transmission-process-callback (process)
"Call PROCESS's callback if it has one."
(let ((callback (process-get process :callback)))
(when callback
(transmission--move-to-content)
(when (search-forward "\"arguments\":" nil t)
(run-at-time 0 nil callback (json-read))))))
(defun transmission-process-filter (process text)
"Handle PROCESS's output TEXT and trigger handlers."
(internal-default-process-filter process text)
(when (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
(when (transmission--content-finished-p)
(condition-case e
(progn (transmission--status)
(transmission-process-callback process)
(stop-process process))
(transmission-conflict
(transmission-http-post process (process-get process :request)))
(transmission-failure
(message "%s" (cdr e)))
(error
(stop-process process)
(signal (car e) (cdr e))))))))
(defun transmission-request-async (callback method &optional arguments tag)
"Send a request to Transmission asynchronously.
CALLBACK accepts one argument, the response \"arguments\" JSON object.
METHOD, ARGUMENTS, and TAG are the same as in `transmission-request'."
(let ((process (transmission-get-network-process))
(content (json-encode `(:method ,method :arguments ,arguments :tag ,tag))))
(set-process-filter process #'transmission-process-filter)
(set-process-sentinel process #'transmission-process-sentinel)
(process-put process :request content)
(process-put process :callback callback)
(transmission-http-post process content)
process))
;; Response destructuring
(defun transmission-torrents (response)
"Return the \"torrents\" array in RESPONSE, otherwise nil."
(let ((torrents (cdr (assq 'torrents response))))
(and (< 0 (length torrents)) torrents)))
(defun transmission-unique-labels (torrents)
"Return a list of unique labels from TORRENTS."
(let (labels res)
(dotimes (i (length torrents))
(dotimes (j (length (setq labels (cdr (assq 'labels (aref torrents i))))))
(cl-pushnew (aref labels j) res :test #'equal)))
res))
;; Timer management
(defun transmission-timer-revert ()
"Revert the buffer or cancel `transmission-timer'."
(if (and (memq major-mode transmission-refresh-modes)
(not (or (bound-and-true-p isearch-mode)
(buffer-narrowed-p)
(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)
"Return 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."
(if (zerop total) 0 (/ (* 100.0 have) total)))
(defun transmission-slice (str k)
"Slice STRING into K strings of somewhat equal size.
The result can have no more elements than STRING.
\n(fn STRING K)"
(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-text-property-all (beg end prop)
"Return a list of non-nil values of a text property PROP between BEG and END.
If none are found, return nil."
(let (res pos)
(save-excursion
(goto-char beg)
(while (> end (point))
(push (get-text-property (point) prop) res)
(setq pos (text-property-not-all (point) end prop (car-safe res)))
(goto-char (or pos end))))
(nreverse (delq nil res))))
(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)
(if (= percent 1) "Done"
(if (char-displayable-p #x221e) "\u221e" "Inf"))
(let* ((minute 60.0)
(hour 3600.0)
(day 86400.0)
(month (* 29.53 day))
(year (* 365.25 day)))
(apply #'format "%.0f%s"
(cond
((> minute seconds) (list seconds "s"))
((> hour seconds) (list (/ seconds minute) "m"))
((> day seconds) (list (/ seconds hour) "h"))
((> month seconds) (list (/ seconds day) "d"))
((> year seconds) (list (/ seconds month) "mo"))
(t (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 (float-time (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 keyword; 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 ((arguments `(:ids ,ids ,(pcase limit
(:uploadLimit :uploadLimited)
(:downloadLimit :downloadLimited))
,@(if (< n 0) '(:json-false) `(t ,limit ,n)))))
(transmission-request-async nil "torrent-set" arguments)))
(defun transmission-torrent-honors-speed-limits-p ()
"Return non-nil if torrent honors session speed limits, otherwise nil."
(eq t (cdr (assq 'honorsSessionLimits (elt transmission-torrent-vector 0)))))
(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 ((args '(:fields ["speed-limit-up" "speed-limit-down"
"speed-limit-up-enabled" "speed-limit-down-enabled"])))
(let-alist (transmission-request "session-get" args)
(let ((limit (if upload .speed-limit-up .speed-limit-down))
(enabled (eq t (if upload .speed-limit-up-enabled
.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 ((arguments '(:fields ["seedRatioLimit" "seedRatioLimited"])))
(let-alist (transmission-request "session-get" arguments)
(let ((limit .seedRatioLimit)
(enabled (eq t .seedRatioLimited)))
(list (read-number (concat "Set global seed ratio limit ("
(if enabled (format "%.1f" limit) "disabled")
"): ")))))))
(defun transmission-read-strings (prompt &optional collection history filter)
"Read strings until an input is blank, with optional completion.
PROMPT, COLLECTION, and HISTORY are the same as in `completing-read'.
FILTER is a predicate that prevents adding failing input to HISTORY.
Returns a list of non-blank inputs."
(let ((history-add-new-input (null history))
res entry)
(while (and (setq entry (if (not collection) (read-string prompt nil history)
(completing-read prompt collection nil nil nil history)))
(not (string-empty-p entry))
(not (string-blank-p entry)))
(when (and history (or (null filter) (funcall filter entry)))
(add-to-history history entry))
(push entry res)
(when (consp collection)
(setq collection (delete entry collection))))
(nreverse res)))
(defun transmission-read-time (prompt)
"Read an expression for time, prompting with string PROMPT.
Uses `diary-entry-time' to parse user input.
Returns minutes from midnight, otherwise nil."
(let ((hhmm (diary-entry-time (read-string prompt))))
(when (>= hhmm 0) (+ (% hhmm 100) (* 60 (/ hhmm 100))))))
(defun transmission-format-minutes (minutes)
"Return a formatted string from MINUTES from midnight."
(format-time-string "%H:%M" (seconds-to-time (* 60 (+ 300 minutes)))))
(defun transmission-n->days (n)
"Return days corresponding to bitfield N.
Days are the keys of `transmission-schedules'."
(cond
((let ((cell (rassq n transmission-schedules)))
(when cell (list (car cell)))))
((let (res)
(pcase-dolist (`(,k . ,v) transmission-schedules)
(unless (zerop (logand n v))
(push k res)
(cl-decf n v)))
(nreverse res)))))
(defun transmission-levi-civita (a b c)
"Return Levi-Civita symbol value for three numbers A, B, C."
(cond
((or (< a b c) (< b c a) (< c a b)) 1)
((or (< c b a) (< a c b) (< b a c)) -1)
((or (= a b) (= b c) (= c a)) 0)))
(defun transmission-turtle-when (beg end &optional now)
"Calculate the time in seconds until the next schedule change.
BEG END are minutes after midnight of schedules start and end.
NOW is a time, defaulting to `current-time'."
(let* ((time (or now (current-time)))
(hours (string-to-number (format-time-string "%H" time)))
(minutes (+ (* 60 hours)
(string-to-number (format-time-string "%M" time)))))
(pcase (transmission-levi-civita minutes beg end)
(1 (* 60 (if (> beg minutes) (- beg minutes) (+ beg minutes))))
(-1 (* 60 (if (> end minutes) (- end minutes) (+ end minutes))))
;; FIXME this should probably just return 0 because of inaccuracy
(0 (* 60 (or (and (= minutes beg) end) (and (= minutes end) beg)))))))
(defun transmission-tracker-url-p (str)
"Return non-nil if STR is not just a number."
(let ((match (string-match "[^[:blank:]]" str)))
(when match (null (<= ?0 (aref str match) ?9)))))
(defun transmission-tracker-stats (id)
"Return the \"trackerStats\" array for torrent id ID."
(let* ((arguments `(:ids ,id :fields ["trackerStats"]))
(response (transmission-request "torrent-get" arguments)))
(cdr (assq 'trackerStats (elt (transmission-torrents response) 0)))))
(defun transmission-unique-announce-urls ()
"Return a list of unique announce URLs from all current torrents."
(let ((response (transmission-request "torrent-get" '(:fields ["trackers"])))
torrents trackers res)
(dotimes (i (length (setq torrents (transmission-torrents response))))
(dotimes (j (length (setq trackers (cdr (assq 'trackers (aref torrents i))))))
(cl-pushnew (cdr (assq 'announce (aref trackers j))) res :test #'equal)))
res))
(defun transmission-btih-p (string)
"Return STRING if it is a BitTorrent info hash, otherwise nil."
(and string (string-match (rx bos (= 40 xdigit) eos) 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 (run-hook-with-args-until-success 'file-name-at-point-functions)))
(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)
(prop 'tabulated-list-id)
indices)
(setq indices
(or transmission-marked-ids
(if (null (use-region-p))
(list (cdr (assq 'index (get-text-property (point) prop))))
(transmission-refs (transmission-text-property-all
(region-beginning) (region-end) prop)
'index))))
(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 (cdr (assq 'downloadDir (elt transmission-torrent-vector 0))))
(base (or (and dir (cdr (assq 'name (tabulated-list-get-id))))
(user-error "No file at point")))
(filename (and base (expand-file-name base dir))))
(or (file-exists-p filename)
(let ((part (concat filename ".part")))
(and (file-exists-p part) (setq filename part))))
(if filename (abbreviate-file-name filename)
(user-error "File does not exist"))))
(defun transmission-files-index (torrent)
"Return an array containing file data from TORRENT."
(let-alist torrent
(let* ((n (length .files))
(res (make-vector n 0)))
(dotimes (i n)
(aset res i (append (aref .files i)
(list (cons 'wanted (aref .wanted i))
(cons 'priority (aref .priorities i))
(cons 'index i)))))
res)))
(defun transmission-files-prefix (files)
"Return a directory name that is a prefix of every path in FILES, otherwise nil."
(when (> (length files) 0)
(let ((ref (cdr (assq 'name (aref files 0))))
(start 0)
end)
(setq files (substring files 1))
(while (and (prog1 (string-match "/" ref start)
(setq end (match-end 0)))
(cl-loop for file across files
always (eq t (compare-strings
ref start end (cdr (assq 'name file)) start end))))
(setq start end))
(substring ref 0 start))))
(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-table'.
If IP is not a key, add it with the value from `transmission-geoip-function'.
If `transmission-geoip-function' has changed, reset `transmission-geoip-table'."
(let ((fun transmission-geoip-function)
(cache transmission-geoip-table))
(when (functionp fun)
(if (not transmission-geoip-use-cache)
(funcall fun ip)
(if (eq fun (get 'transmission-geoip-table :fn))
(or (gethash ip cache)
(setf (gethash ip cache) (funcall fun ip)))
(setq cache (make-hash-table :test 'equal))
(put 'transmission-geoip-table :fn fun)
(setf (gethash ip cache) (funcall fun 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 (byte)
"Calculate the Hamming weight of BYTE."
(setq byte (- byte (logand (lsh byte -1) #x55555555)))
(setq byte (+ (logand byte #x33333333) (logand (lsh byte -2) #x33333333)))
(lsh (* (logand (+ byte (lsh byte -4)) #x0f0f0f0f) #x01010101) -24))
(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."
(cond
((= 0 ratio) " ")
((< ratio 0.333) "\u2591")
((< ratio 0.667) "\u2592")
((< ratio 1) "\u2593")
((= 1 ratio) "\u2588")))
(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-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 (when (/= m 1) "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)))
(defun transmission-toggle-mark-at-point ()
"Toggle mark of item at point.
Registers the change in `transmission-marked-ids'."
(let* ((eid (tabulated-list-get-id))
(id (cdr (or (assq 'hashString eid) (assq 'index eid)))))
(if (member id transmission-marked-ids)
(progn
(setq transmission-marked-ids (delete id transmission-marked-ids))
(tabulated-list-put-tag " "))
(push id transmission-marked-ids)
(tabulated-list-put-tag ">"))
(set-buffer-modified-p nil)))
(defun transmission-move-to-file-name ()
"Move to the beginning of the filename on the current line."
(let* ((eol (line-end-position))
(change (next-single-property-change (point) 'transmission-name nil eol)))
(when (and change (< change eol))
(goto-char change))))
(defun transmission-file-name-matcher (limit)
(let ((beg (next-single-property-change (point) 'transmission-name nil limit)))
(when (and beg (< beg limit))
(goto-char beg)
(let ((end (next-single-property-change (point) 'transmission-name nil limit)))
(when (and end (<= end limit))
(set-match-data (list beg end))
(goto-char end))))))
(defmacro transmission-interactive (&rest spec)
"Specify interactive use of a function.
The symbol `ids' is bound to a list of torrent IDs marked, at
point or in region, otherwise a `user-error' is signalled."
(declare (debug t))
(let ((region (make-symbol "region"))
(marked (make-symbol "marked"))
(torrent (make-symbol "torrent")))
`(interactive
(let ((,torrent transmission-torrent-id) ,marked ,region ids)
(setq ids (or (and ,torrent (list ,torrent))
(setq ,marked transmission-marked-ids)))
(when (null ids)
(if (setq ,region (use-region-p))
(setq ids
(cl-loop for x in
(transmission-text-property-all
(region-beginning) (region-end) 'tabulated-list-id)
collect (cdr (assq 'hashString x))))