2 exec guile -e main -s "$0" "$@"
5 ;;; gnunet-download-manager -- Manage GNUnet downloads.
6 ;;; Copyright (C) 2004 Ludovic Courtès
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.
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.
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.
22 ;;; Remember ongoing GNUnet downloads so as to be able to resume them
23 ;;; later. Typical usage is to define the following alias in your
26 ;;; alias gnunet-download='gnunet-download-manager.scm download'
28 ;;; You may have a ~/.gnunet-download-manager.scm Scheme configuration
29 ;;; file. In particular, if you would like to be notified of
30 ;;; completed downloads, you may want to add the following line to
31 ;;; your configuration file:
33 ;;; (add-hook! *completed-download-hook*
34 ;;; completed-download-notification-hook)
36 ;;; This script works fine with GNU Guile 1.6.4, and doesn't run with
40 ;;; Ludovic Courtès <ludo@chbouib.org>
42 (use-modules (ice-9 format)
47 (ice-9 documentation))
49 ;; Overall user settings
51 (define *rc-file* (string-append (getenv "HOME")
52 "/.gnunet-download-manager.scm"))
53 (define *status-directory* (string-append (getenv "HOME") "/"
54 ".gnunet-download-manager"))
55 (define *gnunet-download* "gnunet-download")
58 (define-macro (gnunet-info fmt . args)
59 `(format #t (string-append *program-name* ": " ,fmt "~%")
62 (define-macro (gnunet-debug fmt . args)
64 (cons 'gnunet-info (cons fmt args))
67 (define-macro (gnunet-error fmt . args)
68 `(and ,(cons 'gnunet-info (cons fmt args))
71 (define (exception-string key args)
72 "Describe an error, using the format from @var{args}, if available."
73 (if (< (length args) 4)
74 (format #f "Scheme exception: ~S" key)
76 (if (string? (car args))
77 (string-append "In " (car args))
80 (apply format `(#f ,(cadr args) ,@(caddr args))))))
83 ;; Regexps matching GNUnet URIs
85 "([[:alnum:]]+).([[:alnum:]]+).([[:alnum:]]+).([0-9]+)")
87 (make-regexp (string-append "^gnunet://fs/chk/" *uri-base* "$")
89 (define *uri-status-file-re*
90 (make-regexp (string-append "^" *uri-base* "$")
94 (define (uri-status-file-name directory uri)
95 "Return the name of the status file for URI @var{uri}."
96 (let ((match (regexp-exec *uri-re* uri)))
98 (and (gnunet-info "~a: Invalid URI" uri) #f)
99 (let ((start (match:start match 1))
100 (end (match:end match 4)))
101 (string-append directory "/"
102 (substring uri start end))))))
104 (define (uri-status directory uri)
105 "Load the current status alist for URI @var{uri} from @var{directory}."
106 (gnunet-debug "uri-status")
107 (let ((filename (uri-status-file-name directory uri)))
110 (let* ((file (open-input-file filename))
111 (status (read file)))
116 (and (gnunet-debug (exception-string key args))
119 (define (process-exists? pid)
120 (false-if-exception (begin (kill pid 0) #t)))
122 (define (fork-and-exec directory program . args)
123 "Launch @var{program} and return its PID."
124 (gnunet-debug "fork-and-exec: ~a ~a" program args)
125 (let ((pid (primitive-fork)))
128 (if directory (chdir directory))
129 (apply execlp (cons program (cons program args))))
132 (define* (start-downloader downloader uri options
133 #:key (directory #f))
134 "Start the GNUnet downloader for URI @var{uri} with options
135 @var{options}. Return an alist describing the download status."
138 (let* ((pid (apply fork-and-exec
139 `(,(if directory directory (getcwd))
142 (gnunet-info "Launched process ~a" pid)
144 (working-directory . ,(if directory directory (getcwd)))
147 (downloader-pid . ,pid))))
149 (gnunet-error (exception-string key args)))))
151 (define (download-process-alive? uri-status)
152 "Return true if the download whose status is that described by
153 @var{uri-status} is still alive."
154 (let ((pid (assoc-ref uri-status 'pid))
155 (downloader-pid (assoc-ref uri-status 'downloader-pid)))
156 (and (process-exists? pid)
157 (process-exists? downloader-pid))))
159 (define (start-file-download downloader status-dir uri options)
160 "Dowload the file located at @var{uri}, with options @var{options}
161 and return an updated status alist."
162 (gnunet-debug "start-file-download")
163 (let ((uri-status (uri-status status-dir uri)))
164 (if (null? uri-status)
165 (acons 'start-date (current-time)
166 (start-downloader downloader uri options))
167 (if (download-process-alive? uri-status)
168 (and (gnunet-info "~a already being downloaded by process ~a"
169 uri (assoc-ref uri-status 'pid))
171 (and (gnunet-info "Resuming download")
172 (let ((start-date (assoc-ref uri-status 'start-date))
173 (dir (assoc-ref uri-status 'working-directory))
174 (options (assoc-ref uri-status 'options)))
175 (acons 'start-date start-date
176 (start-downloader downloader uri options
177 #:directory dir))))))))
179 (define *completed-download-hook* (make-hook 1))
181 (define (download-file downloader status-dir uri options)
182 "Start downloading file located at URI @var{uri}, with options
183 @var{options}, resuming it if it's already started."
186 (and-let* ((status (start-file-download downloader
189 (pid (assoc-ref status 'downloader-pid))
190 (filename (uri-status-file-name status-dir
192 (file (open-file filename "w")))
194 ;; Write down the status
195 (pretty-print status file)
198 ;; Wait for `gnunet-download'
199 (gnunet-info "Waiting for process ~a" pid)
200 (let* ((process-status (waitpid pid))
201 (exit-val (status:exit-val (cdr process-status)))
202 (term-sig (status:term-sig (cdr process-status))))
205 (delete-file filename)
207 "Download completed (PID ~a, exit code ~a)"
209 (let ((ret `((end-date . ,(current-time))
210 (exit-code . ,exit-val)
211 (terminating-signal . ,term-sig)
213 (run-hook *completed-download-hook* ret)
216 (gnunet-error (exception-string key args)))))
218 (define (uri-status-files directory)
219 "Return the list of URI status files in @var{directory}."
222 (let ((dir (opendir directory)))
223 (let loop ((filename (readdir dir))
225 (if (eof-object? filename)
227 (if (regexp-exec *uri-status-file-re* filename)
229 (cons filename file-list))
230 (loop (readdir dir) file-list))))))
232 (gnunet-error (exception-string key args)))))
234 (define (output-file-option option-list)
235 "Return the output file specified in @var{option-list}, false if
237 (if (null? option-list)
239 (let ((rest (cdr option-list))
240 (opt (car option-list)))
243 (if (or (string=? opt "-o")
244 (string=? opt "--output"))
246 (output-file-option rest))))))
248 (define (download-command . args)
249 "Start downloading a file using the given `gnunet-download'
251 (gnunet-debug "download-command")
252 (let* ((argc (length args))
253 ;; FIXME: We're assuming the URI is the last argument
254 (uri (car (list-tail args (- argc 1))))
256 (download-file *gnunet-download* *status-directory* uri options)))
258 (define (status-command . args)
259 "Print status info about files being downloaded."
260 (for-each (lambda (status)
261 (format #t "~a: ~a~% ~a~% ~a~% ~a~%"
262 (assoc-ref status 'uri)
263 (if (download-process-alive? status)
264 (string-append "running (PID "
265 (number->string (assoc-ref status
269 (string-append "Started on "
271 (localtime (assoc-ref
274 (string-append "Directory: "
277 (string-append "Output file: "
278 (or (output-file-option (assoc-ref
283 (uri-status *status-directory*
284 (string-append "gnunet://fs/chk/" file)))
285 (uri-status-files *status-directory*))))
287 (define (resume-command . args)
288 "Resume stopped downloads."
289 (for-each (lambda (status)
290 (if (not (download-process-alive? status))
291 (if (= 0 (primitive-fork))
292 (let* ((ret (download-file *gnunet-download*
294 (assoc-ref status 'uri)
295 (assoc-ref status 'options)))
296 (code (assoc-ref ret 'exit-code)))
299 (uri-status *status-directory*
300 (string-append "gnunet://fs/chk/" file)))
301 (uri-status-files *status-directory*))))
303 (define (killall-command . args)
304 "Stop all running downloads."
305 (for-each (lambda (status)
306 (if (download-process-alive? status)
307 (let ((pid (assoc-ref status 'pid))
308 (dl-pid (assoc-ref status 'downloader-pid)))
309 (and (gnunet-info "Stopping processes ~a and ~a"
314 (uri-status *status-directory*
315 (string-append "gnunet://fs/chk/" file)))
316 (uri-status-files *status-directory*))))
319 (define (help-command . args)
320 "Show this help message."
321 (format #t "Usage: ~a <command> [options]~%" *program-name*)
322 (format #t "Where <command> may be one of the following:~%~%")
323 (for-each (lambda (command)
324 (if (not (eq? (cdr command) help-command))
325 (format #t (string-append " " (car command) ": "
326 (object-documentation
332 (define (settings-command . args)
333 "Dump the current settings."
334 (format #t "Current settings:~%~%")
335 (module-for-each (lambda (symbol variable)
336 (if (string-match "^\\*.*\\*$" (symbol->string symbol))
337 (format #t " ~a: ~a~%"
338 symbol (variable-ref variable))))
342 (define (version-command . args)
343 "Show version information."
344 (format #t "~a ~a.~a (~a)~%"
345 *program-name* *version-major* *version-minor* *version-date*))
347 ;; This hook may be added to *completed-download-hook*.
348 (define (completed-download-notification-hook status)
349 "Notifies of the completion of a file download."
350 (let ((msg (string-append "GNUnet download of "
352 (assoc-ref status 'options))
357 (if (getenv "DISPLAY")
358 (waitpid (fork-and-exec #f "xmessage" msg))
359 (waitpid (fork-and-exec #f "write"
362 ;; Available user commands
364 `(("download" . ,download-command)
365 ("status" . ,status-command)
366 ("resume" . ,resume-command)
367 ("killall" . ,killall-command)
368 ("settings" . ,settings-command)
369 ("version" . ,version-command)
370 ("help" . ,help-command)
371 ("--help" . ,help-command)
372 ("-h" . ,help-command)))
374 (define *program-name* "gnunet-download-manager")
375 (define *version-major* 0)
376 (define *version-minor* 1)
377 (define *version-date* "april 2004")
380 (set! *program-name* (basename (car args)))
382 ;; Load the user's configuration file
383 (if (file-exists? *rc-file*)
386 ;; Check whether the status directory already exists
387 (if (not (file-exists? *status-directory*))
389 (gnunet-info "Creating status directory ~a..." *status-directory*)
392 (mkdir *status-directory*))
394 (and (gnunet-error (exception-string key args))
398 (if (< (length args) 2)
399 (and (format #t "Usage: ~a <command> [options]~%"
402 (let* ((command-name (cadr args))
403 (command (assoc-ref *commands* command-name)))
405 (apply command (cddr args))
406 (and (gnunet-info "~a command not found" command-name)