diff options
author | ng0 <ng0@n0.is> | 2019-04-06 22:31:56 +0000 |
---|---|---|
committer | ng0 <ng0@n0.is> | 2019-04-06 22:31:56 +0000 |
commit | d293c058c38e16ba21cbded1ce76b590a0815b79 (patch) | |
tree | eb5f924c23992291aa695058cb1740e97809c6ca /contrib | |
parent | d182da40510d0efbac5628630e7cda5e8a4c0e5a (diff) | |
download | gnunet-d293c058c38e16ba21cbded1ce76b590a0815b79.tar.gz gnunet-d293c058c38e16ba21cbded1ce76b590a0815b79.zip |
move gnunet-download-manager to contrib
Diffstat (limited to 'contrib')
-rw-r--r-- | contrib/scripts/Makefile.am | 2 | ||||
-rw-r--r-- | contrib/scripts/gnunet-download-manager/Makefile.am | 3 | ||||
-rwxr-xr-x | contrib/scripts/gnunet-download-manager/gnunet-download-manager.scm | 409 |
3 files changed, 413 insertions, 1 deletions
diff --git a/contrib/scripts/Makefile.am b/contrib/scripts/Makefile.am index 5dc94439b..987b6f973 100644 --- a/contrib/scripts/Makefile.am +++ b/contrib/scripts/Makefile.am | |||
@@ -1,7 +1,7 @@ | |||
1 | # This Makefile.am is in the public domain | 1 | # This Makefile.am is in the public domain |
2 | AM_CPPFLAGS = -I$(top_srcdir)/src/include -I$(top_builddir)/src/include | 2 | AM_CPPFLAGS = -I$(top_srcdir)/src/include -I$(top_builddir)/src/include |
3 | 3 | ||
4 | SUBDIRS = gnunet-logread | 4 | SUBDIRS = gnunet-logread gnunet-download-manager |
5 | 5 | ||
6 | noinst_SCRIPTS = \ | 6 | noinst_SCRIPTS = \ |
7 | terminate.py \ | 7 | terminate.py \ |
diff --git a/contrib/scripts/gnunet-download-manager/Makefile.am b/contrib/scripts/gnunet-download-manager/Makefile.am new file mode 100644 index 000000000..059e0229b --- /dev/null +++ b/contrib/scripts/gnunet-download-manager/Makefile.am | |||
@@ -0,0 +1,3 @@ | |||
1 | noinst_SCRIPTS = gnunet-download-manager.scm | ||
2 | |||
3 | EXTRA_DIST = $(noinst_SCRIPTS) | ||
diff --git a/contrib/scripts/gnunet-download-manager/gnunet-download-manager.scm b/contrib/scripts/gnunet-download-manager/gnunet-download-manager.scm new file mode 100755 index 000000000..0b4301cc8 --- /dev/null +++ b/contrib/scripts/gnunet-download-manager/gnunet-download-manager.scm | |||
@@ -0,0 +1,409 @@ | |||
1 | #!/bin/sh | ||
2 | exec guile -e main -s "$0" "$@" | ||
3 | !# | ||
4 | |||
5 | ;;; gnunet-download-manager -- Manage GNUnet downloads. | ||
6 | ;;; Copyright (C) 2004 Ludovic Courtès | ||
7 | ;;; | ||
8 | ;;; This program is free software; you can redistribute it and/or | ||
9 | ;;; modify it under the terms of the GNU General Public License | ||
10 | ;;; as published by the Free Software Foundation; either version 2 | ||
11 | ;;; of the License, or (at your option) any later version. | ||
12 | ;;; | ||
13 | ;;; This program is distributed in the hope that it will be useful, | ||
14 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
16 | ;;; GNU General Public License for more details. | ||
17 | ;;; | ||
18 | ;;; You should have received a copy of the GNU General Public License | ||
19 | ;;; along with this program; if not, write to the Free Software | ||
20 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | ||
21 | ;;; | ||
22 | ;;; SPDX-License-Identifier: GPL-2.0-or-later | ||
23 | |||
24 | ;;; Remember ongoing GNUnet downloads so as to be able to resume them | ||
25 | ;;; later. Typical usage is to define the following alias in your | ||
26 | ;;; favorite shell: | ||
27 | ;;; | ||
28 | ;;; alias gnunet-download='gnunet-download-manager.scm download' | ||
29 | ;;; | ||
30 | ;;; You may have a ~/.gnunet-download-manager.scm Scheme configuration | ||
31 | ;;; file. In particular, if you would like to be notified of | ||
32 | ;;; completed downloads, you may want to add the following line to | ||
33 | ;;; your configuration file: | ||
34 | ;;; | ||
35 | ;;; (add-hook! *completed-download-hook* | ||
36 | ;;; completed-download-notification-hook) | ||
37 | ;;; | ||
38 | ;;; This script works fine with GNU Guile 1.6.4, and doesn't run with | ||
39 | ;;; Guile 1.4.x. | ||
40 | ;;; | ||
41 | ;;; Enjoy! | ||
42 | ;;; Ludovic Courtès <ludo@chbouib.org> | ||
43 | |||
44 | (use-modules (ice-9 format) | ||
45 | (ice-9 optargs) | ||
46 | (ice-9 regex) | ||
47 | (ice-9 and-let-star) | ||
48 | (ice-9 pretty-print) | ||
49 | (ice-9 documentation)) | ||
50 | |||
51 | ;; Overall user settings | ||
52 | (define *debug?* #f) | ||
53 | (define *rc-file* (string-append (getenv "HOME") | ||
54 | "/.gnunet-download-manager.scm")) | ||
55 | (define *status-directory* (string-append (getenv "HOME") "/" | ||
56 | ".gnunet-download-manager")) | ||
57 | (define *gnunet-download* "gnunet-download") | ||
58 | |||
59 | ;; Helper macros | ||
60 | (define-macro (gnunet-info fmt . args) | ||
61 | `(format #t (string-append *program-name* ": " ,fmt "~%") | ||
62 | ,@args)) | ||
63 | |||
64 | (define-macro (gnunet-debug fmt . args) | ||
65 | (if *debug?* | ||
66 | (cons 'gnunet-info (cons fmt args)) | ||
67 | #t)) | ||
68 | |||
69 | (define-macro (gnunet-error fmt . args) | ||
70 | `(and ,(cons 'gnunet-info (cons fmt args)) | ||
71 | (exit 1))) | ||
72 | |||
73 | (define (exception-string key args) | ||
74 | "Describe an error, using the format from @var{args}, if available." | ||
75 | (if (< (length args) 4) | ||
76 | (format #f "Scheme exception: ~S" key) | ||
77 | (string-append | ||
78 | (if (string? (car args)) | ||
79 | (string-append "In " (car args)) | ||
80 | "Scheme exception") | ||
81 | ": " | ||
82 | (apply format `(#f ,(cadr args) ,@(caddr args)))))) | ||
83 | |||
84 | |||
85 | ;; Regexps matching GNUnet URIs | ||
86 | (define *uri-base* | ||
87 | "([[:alnum:]]+).([[:alnum:]]+).([[:alnum:]]+).([0-9]+)") | ||
88 | (define *uri-re* | ||
89 | (make-regexp (string-append "^gnunet://fs/chk/" *uri-base* "$") | ||
90 | regexp/extended)) | ||
91 | (define *uri-status-file-re* | ||
92 | (make-regexp (string-append "^" *uri-base* "$") | ||
93 | regexp/extended)) | ||
94 | |||
95 | |||
96 | (define (uri-status-file-name directory uri) | ||
97 | "Return the name of the status file for URI @var{uri}." | ||
98 | (let ((match (regexp-exec *uri-re* uri))) | ||
99 | (if (not match) | ||
100 | (and (gnunet-info "~a: Invalid URI" uri) #f) | ||
101 | (let ((start (match:start match 1)) | ||
102 | (end (match:end match 4))) | ||
103 | (string-append directory "/" | ||
104 | (substring uri start end)))))) | ||
105 | |||
106 | (define (uri-status directory uri) | ||
107 | "Load the current status alist for URI @var{uri} from @var{directory}." | ||
108 | (gnunet-debug "uri-status") | ||
109 | (let ((filename (uri-status-file-name directory uri))) | ||
110 | (catch 'system-error | ||
111 | (lambda () | ||
112 | (let* ((file (open-input-file filename)) | ||
113 | (status (read file))) | ||
114 | (begin | ||
115 | (close-port file) | ||
116 | status))) | ||
117 | (lambda (key . args) | ||
118 | (and (gnunet-debug (exception-string key args)) | ||
119 | '()))))) | ||
120 | |||
121 | (define (process-exists? pid) | ||
122 | (false-if-exception (begin (kill pid 0) #t))) | ||
123 | |||
124 | (define (fork-and-exec directory program . args) | ||
125 | "Launch @var{program} and return its PID." | ||
126 | (gnunet-debug "fork-and-exec: ~a ~a" program args) | ||
127 | (let ((pid (primitive-fork))) | ||
128 | (if (= 0 pid) | ||
129 | (begin | ||
130 | (if directory (chdir directory)) | ||
131 | (apply execlp (cons program (cons program args)))) | ||
132 | pid))) | ||
133 | |||
134 | (define* (start-downloader downloader uri options | ||
135 | #:key (directory #f)) | ||
136 | "Start the GNUnet downloader for URI @var{uri} with options | ||
137 | @var{options}. Return an alist describing the download status." | ||
138 | (catch 'system-error | ||
139 | (lambda () | ||
140 | (let* ((pid (apply fork-and-exec | ||
141 | `(,(if directory directory (getcwd)) | ||
142 | ,downloader | ||
143 | ,@options)))) | ||
144 | (gnunet-info "Launched process ~a" pid) | ||
145 | `((uri . ,uri) | ||
146 | (working-directory . ,(if directory directory (getcwd))) | ||
147 | (options . ,options) | ||
148 | (pid . ,(getpid)) | ||
149 | (downloader-pid . ,pid)))) | ||
150 | (lambda (key . args) | ||
151 | (gnunet-error (exception-string key args))))) | ||
152 | |||
153 | (define (download-process-alive? uri-status) | ||
154 | "Return true if the download whose status is that described by | ||
155 | @var{uri-status} is still alive." | ||
156 | (let ((pid (assoc-ref uri-status 'pid)) | ||
157 | (downloader-pid (assoc-ref uri-status 'downloader-pid))) | ||
158 | (and (process-exists? pid) | ||
159 | (process-exists? downloader-pid)))) | ||
160 | |||
161 | (define (start-file-download downloader status-dir uri options) | ||
162 | "Dowload the file located at @var{uri}, with options @var{options} | ||
163 | and return an updated status alist." | ||
164 | (gnunet-debug "start-file-download") | ||
165 | (let ((uri-status (uri-status status-dir uri))) | ||
166 | (if (null? uri-status) | ||
167 | (acons 'start-date (current-time) | ||
168 | (start-downloader downloader uri options)) | ||
169 | (if (download-process-alive? uri-status) | ||
170 | (and (gnunet-info "~a already being downloaded by process ~a" | ||
171 | uri (assoc-ref uri-status 'pid)) | ||
172 | #f) | ||
173 | (and (gnunet-info "Resuming download") | ||
174 | (let ((start-date (assoc-ref uri-status 'start-date)) | ||
175 | (dir (assoc-ref uri-status 'working-directory)) | ||
176 | (options (assoc-ref uri-status 'options))) | ||
177 | (acons 'start-date start-date | ||
178 | (start-downloader downloader uri options | ||
179 | #:directory dir)))))))) | ||
180 | |||
181 | (define *completed-download-hook* (make-hook 1)) | ||
182 | |||
183 | (define (download-file downloader status-dir uri options) | ||
184 | "Start downloading file located at URI @var{uri}, with options | ||
185 | @var{options}, resuming it if it's already started." | ||
186 | (catch 'system-error | ||
187 | (lambda () | ||
188 | (and-let* ((status (start-file-download downloader | ||
189 | status-dir | ||
190 | uri options)) | ||
191 | (pid (assoc-ref status 'downloader-pid)) | ||
192 | (filename (uri-status-file-name status-dir | ||
193 | uri)) | ||
194 | (file (open-file filename "w"))) | ||
195 | |||
196 | ;; Write down the status | ||
197 | (pretty-print status file) | ||
198 | (close-port file) | ||
199 | |||
200 | ;; Wait for `gnunet-download' | ||
201 | (gnunet-info "Waiting for process ~a" pid) | ||
202 | (let* ((process-status (waitpid pid)) | ||
203 | (exit-val (status:exit-val (cdr process-status))) | ||
204 | (term-sig (status:term-sig (cdr process-status)))) | ||
205 | |||
206 | ;; Terminate | ||
207 | (delete-file filename) | ||
208 | (gnunet-info | ||
209 | "Download completed (PID ~a, exit code ~a)" | ||
210 | pid exit-val) | ||
211 | (let ((ret `((end-date . ,(current-time)) | ||
212 | (exit-code . ,exit-val) | ||
213 | (terminating-signal . ,term-sig) | ||
214 | ,@status))) | ||
215 | (run-hook *completed-download-hook* ret) | ||
216 | ret)))) | ||
217 | (lambda (key . args) | ||
218 | (gnunet-error (exception-string key args))))) | ||
219 | |||
220 | (define (uri-status-files directory) | ||
221 | "Return the list of URI status files in @var{directory}." | ||
222 | (catch 'system-error | ||
223 | (lambda () | ||
224 | (let ((dir (opendir directory))) | ||
225 | (let loop ((filename (readdir dir)) | ||
226 | (file-list '())) | ||
227 | (if (eof-object? filename) | ||
228 | file-list | ||
229 | (if (regexp-exec *uri-status-file-re* filename) | ||
230 | (loop (readdir dir) | ||
231 | (cons filename file-list)) | ||
232 | (loop (readdir dir) file-list)))))) | ||
233 | (lambda (key . args) | ||
234 | (gnunet-error (exception-string key args))))) | ||
235 | |||
236 | (define (output-file-option option-list) | ||
237 | "Return the output file specified in @var{option-list}, false if | ||
238 | anavailable." | ||
239 | (if (null? option-list) | ||
240 | #f | ||
241 | (let ((rest (cdr option-list)) | ||
242 | (opt (car option-list))) | ||
243 | (if (null? rest) | ||
244 | #f | ||
245 | (if (or (string=? opt "-o") | ||
246 | (string=? opt "--output")) | ||
247 | (car rest) | ||
248 | (output-file-option rest)))))) | ||
249 | |||
250 | (define (download-command . args) | ||
251 | "Start downloading a file using the given `gnunet-download' | ||
252 | arguments." | ||
253 | (gnunet-debug "download-command") | ||
254 | (let* ((argc (length args)) | ||
255 | ;; FIXME: We're assuming the URI is the last argument | ||
256 | (uri (car (list-tail args (- argc 1)))) | ||
257 | (options args)) | ||
258 | (download-file *gnunet-download* *status-directory* uri options))) | ||
259 | |||
260 | (define (status-command . args) | ||
261 | "Print status info about files being downloaded." | ||
262 | (for-each (lambda (status) | ||
263 | (format #t "~a: ~a~% ~a~% ~a~% ~a~%" | ||
264 | (assoc-ref status 'uri) | ||
265 | (if (download-process-alive? status) | ||
266 | (string-append "running (PID " | ||
267 | (number->string (assoc-ref status | ||
268 | 'pid)) | ||
269 | ")") | ||
270 | "not running") | ||
271 | (string-append "Started on " | ||
272 | (strftime "%c" | ||
273 | (localtime (assoc-ref | ||
274 | status | ||
275 | 'start-date)))) | ||
276 | (string-append "Directory: " | ||
277 | (assoc-ref status | ||
278 | 'working-directory)) | ||
279 | (string-append "Output file: " | ||
280 | (or (output-file-option (assoc-ref | ||
281 | status | ||
282 | 'options)) | ||
283 | "<unknown>")))) | ||
284 | (map (lambda (file) | ||
285 | (uri-status *status-directory* | ||
286 | (string-append "gnunet://fs/chk/" file))) | ||
287 | (uri-status-files *status-directory*)))) | ||
288 | |||
289 | (define (resume-command . args) | ||
290 | "Resume stopped downloads." | ||
291 | (for-each (lambda (status) | ||
292 | (if (not (download-process-alive? status)) | ||
293 | (if (= 0 (primitive-fork)) | ||
294 | (let* ((ret (download-file *gnunet-download* | ||
295 | *status-directory* | ||
296 | (assoc-ref status 'uri) | ||
297 | (assoc-ref status 'options))) | ||
298 | (code (assoc-ref ret 'exit-code))) | ||
299 | (exit code))))) | ||
300 | (map (lambda (file) | ||
301 | (uri-status *status-directory* | ||
302 | (string-append "gnunet://fs/chk/" file))) | ||
303 | (uri-status-files *status-directory*)))) | ||
304 | |||
305 | (define (killall-command . args) | ||
306 | "Stop all running downloads." | ||
307 | (for-each (lambda (status) | ||
308 | (if (download-process-alive? status) | ||
309 | (let ((pid (assoc-ref status 'pid)) | ||
310 | (dl-pid (assoc-ref status 'downloader-pid))) | ||
311 | (and (gnunet-info "Stopping processes ~a and ~a" | ||
312 | pid dl-pid) | ||
313 | (kill pid 15) | ||
314 | (kill dl-pid 15))))) | ||
315 | (map (lambda (file) | ||
316 | (uri-status *status-directory* | ||
317 | (string-append "gnunet://fs/chk/" file))) | ||
318 | (uri-status-files *status-directory*)))) | ||
319 | |||
320 | |||
321 | (define (help-command . args) | ||
322 | "Show this help message." | ||
323 | (format #t "Usage: ~a <command> [options]~%" *program-name*) | ||
324 | (format #t "Where <command> may be one of the following:~%~%") | ||
325 | (for-each (lambda (command) | ||
326 | (if (not (eq? (cdr command) help-command)) | ||
327 | (format #t (string-append " " (car command) ": " | ||
328 | (object-documentation | ||
329 | (cdr command)) | ||
330 | "~%")))) | ||
331 | *commands*) | ||
332 | (format #t "~%")) | ||
333 | |||
334 | (define (settings-command . args) | ||
335 | "Dump the current settings." | ||
336 | (format #t "Current settings:~%~%") | ||
337 | (module-for-each (lambda (symbol variable) | ||
338 | (if (string-match "^\\*.*\\*$" (symbol->string symbol)) | ||
339 | (format #t " ~a: ~a~%" | ||
340 | symbol (variable-ref variable)))) | ||
341 | (current-module)) | ||
342 | (format #t "~%")) | ||
343 | |||
344 | (define (version-command . args) | ||
345 | "Show version information." | ||
346 | (format #t "~a ~a.~a (~a)~%" | ||
347 | *program-name* *version-major* *version-minor* *version-date*)) | ||
348 | |||
349 | ;; This hook may be added to *completed-download-hook*. | ||
350 | (define (completed-download-notification-hook status) | ||
351 | "Notifies of the completion of a file download." | ||
352 | (let ((msg (string-append "GNUnet download of " | ||
353 | (output-file-option | ||
354 | (assoc-ref status 'options)) | ||
355 | " in " | ||
356 | (assoc-ref status | ||
357 | 'working-directory) | ||
358 | " complete!"))) | ||
359 | (if (getenv "DISPLAY") | ||
360 | (waitpid (fork-and-exec #f "xmessage" msg)) | ||
361 | (waitpid (fork-and-exec #f "write" | ||
362 | (cuserid) msg))))) | ||
363 | |||
364 | ;; Available user commands | ||
365 | (define *commands* | ||
366 | `(("download" . ,download-command) | ||
367 | ("status" . ,status-command) | ||
368 | ("resume" . ,resume-command) | ||
369 | ("killall" . ,killall-command) | ||
370 | ("settings" . ,settings-command) | ||
371 | ("version" . ,version-command) | ||
372 | ("help" . ,help-command) | ||
373 | ("--help" . ,help-command) | ||
374 | ("-h" . ,help-command))) | ||
375 | |||
376 | (define *program-name* "gnunet-download-manager") | ||
377 | (define *version-major* 0) | ||
378 | (define *version-minor* 1) | ||
379 | (define *version-date* "april 2004") | ||
380 | |||
381 | (define (main args) | ||
382 | (set! *program-name* (basename (car args))) | ||
383 | |||
384 | ;; Load the user's configuration file | ||
385 | (if (file-exists? *rc-file*) | ||
386 | (load *rc-file*)) | ||
387 | |||
388 | ;; Check whether the status directory already exists | ||
389 | (if (not (file-exists? *status-directory*)) | ||
390 | (begin | ||
391 | (gnunet-info "Creating status directory ~a..." *status-directory*) | ||
392 | (catch 'system-error | ||
393 | (lambda () | ||
394 | (mkdir *status-directory*)) | ||
395 | (lambda (key . args) | ||
396 | (and (gnunet-error (exception-string key args)) | ||
397 | (exit 1)))))) | ||
398 | |||
399 | ;; Go ahead | ||
400 | (if (< (length args) 2) | ||
401 | (and (format #t "Usage: ~a <command> [options]~%" | ||
402 | *program-name*) | ||
403 | (exit 1)) | ||
404 | (let* ((command-name (cadr args)) | ||
405 | (command (assoc-ref *commands* command-name))) | ||
406 | (if command | ||
407 | (apply command (cddr args)) | ||
408 | (and (gnunet-info "~a command not found" command-name) | ||
409 | (exit 1)))))) | ||