From d293c058c38e16ba21cbded1ce76b590a0815b79 Mon Sep 17 00:00:00 2001 From: ng0 Date: Sat, 6 Apr 2019 22:31:56 +0000 Subject: move gnunet-download-manager to contrib --- configure.ac | 1 + contrib/scripts/Makefile.am | 2 +- .../scripts/gnunet-download-manager/Makefile.am | 3 + .../gnunet-download-manager.scm | 409 +++++++++++++++++++++ src/fs/Makefile.am | 7 +- src/fs/gnunet-download-manager.scm | 409 --------------------- 6 files changed, 415 insertions(+), 416 deletions(-) create mode 100644 contrib/scripts/gnunet-download-manager/Makefile.am create mode 100755 contrib/scripts/gnunet-download-manager/gnunet-download-manager.scm delete mode 100755 src/fs/gnunet-download-manager.scm diff --git a/configure.ac b/configure.ac index aeb3520dd..8b44bbf86 100644 --- a/configure.ac +++ b/configure.ac @@ -1858,6 +1858,7 @@ contrib/services/openrc/Makefile contrib/services/systemd/Makefile contrib/scripts/Makefile contrib/scripts/gnunet-logread/Makefile +contrib/scripts/gnunet-download-manager/Makefile doc/Makefile doc/man/Makefile doc/doxygen/Makefile 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 @@ # This Makefile.am is in the public domain AM_CPPFLAGS = -I$(top_srcdir)/src/include -I$(top_builddir)/src/include -SUBDIRS = gnunet-logread +SUBDIRS = gnunet-logread gnunet-download-manager noinst_SCRIPTS = \ 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 @@ +noinst_SCRIPTS = gnunet-download-manager.scm + +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 @@ +#!/bin/sh +exec guile -e main -s "$0" "$@" +!# + +;;; gnunet-download-manager -- Manage GNUnet downloads. +;;; Copyright (C) 2004 Ludovic Courtès +;;; +;;; 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 2 +;;; 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, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +;;; +;;; SPDX-License-Identifier: GPL-2.0-or-later + +;;; Remember ongoing GNUnet downloads so as to be able to resume them +;;; later. Typical usage is to define the following alias in your +;;; favorite shell: +;;; +;;; alias gnunet-download='gnunet-download-manager.scm download' +;;; +;;; You may have a ~/.gnunet-download-manager.scm Scheme configuration +;;; file. In particular, if you would like to be notified of +;;; completed downloads, you may want to add the following line to +;;; your configuration file: +;;; +;;; (add-hook! *completed-download-hook* +;;; completed-download-notification-hook) +;;; +;;; This script works fine with GNU Guile 1.6.4, and doesn't run with +;;; Guile 1.4.x. +;;; +;;; Enjoy! +;;; Ludovic Courtès + +(use-modules (ice-9 format) + (ice-9 optargs) + (ice-9 regex) + (ice-9 and-let-star) + (ice-9 pretty-print) + (ice-9 documentation)) + +;; Overall user settings +(define *debug?* #f) +(define *rc-file* (string-append (getenv "HOME") + "/.gnunet-download-manager.scm")) +(define *status-directory* (string-append (getenv "HOME") "/" + ".gnunet-download-manager")) +(define *gnunet-download* "gnunet-download") + +;; Helper macros +(define-macro (gnunet-info fmt . args) + `(format #t (string-append *program-name* ": " ,fmt "~%") + ,@args)) + +(define-macro (gnunet-debug fmt . args) + (if *debug?* + (cons 'gnunet-info (cons fmt args)) + #t)) + +(define-macro (gnunet-error fmt . args) + `(and ,(cons 'gnunet-info (cons fmt args)) + (exit 1))) + +(define (exception-string key args) + "Describe an error, using the format from @var{args}, if available." + (if (< (length args) 4) + (format #f "Scheme exception: ~S" key) + (string-append + (if (string? (car args)) + (string-append "In " (car args)) + "Scheme exception") + ": " + (apply format `(#f ,(cadr args) ,@(caddr args)))))) + + +;; Regexps matching GNUnet URIs +(define *uri-base* + "([[:alnum:]]+).([[:alnum:]]+).([[:alnum:]]+).([0-9]+)") +(define *uri-re* + (make-regexp (string-append "^gnunet://fs/chk/" *uri-base* "$") + regexp/extended)) +(define *uri-status-file-re* + (make-regexp (string-append "^" *uri-base* "$") + regexp/extended)) + + +(define (uri-status-file-name directory uri) + "Return the name of the status file for URI @var{uri}." + (let ((match (regexp-exec *uri-re* uri))) + (if (not match) + (and (gnunet-info "~a: Invalid URI" uri) #f) + (let ((start (match:start match 1)) + (end (match:end match 4))) + (string-append directory "/" + (substring uri start end)))))) + +(define (uri-status directory uri) + "Load the current status alist for URI @var{uri} from @var{directory}." + (gnunet-debug "uri-status") + (let ((filename (uri-status-file-name directory uri))) + (catch 'system-error + (lambda () + (let* ((file (open-input-file filename)) + (status (read file))) + (begin + (close-port file) + status))) + (lambda (key . args) + (and (gnunet-debug (exception-string key args)) + '()))))) + +(define (process-exists? pid) + (false-if-exception (begin (kill pid 0) #t))) + +(define (fork-and-exec directory program . args) + "Launch @var{program} and return its PID." + (gnunet-debug "fork-and-exec: ~a ~a" program args) + (let ((pid (primitive-fork))) + (if (= 0 pid) + (begin + (if directory (chdir directory)) + (apply execlp (cons program (cons program args)))) + pid))) + +(define* (start-downloader downloader uri options + #:key (directory #f)) + "Start the GNUnet downloader for URI @var{uri} with options +@var{options}. Return an alist describing the download status." + (catch 'system-error + (lambda () + (let* ((pid (apply fork-and-exec + `(,(if directory directory (getcwd)) + ,downloader + ,@options)))) + (gnunet-info "Launched process ~a" pid) + `((uri . ,uri) + (working-directory . ,(if directory directory (getcwd))) + (options . ,options) + (pid . ,(getpid)) + (downloader-pid . ,pid)))) + (lambda (key . args) + (gnunet-error (exception-string key args))))) + +(define (download-process-alive? uri-status) + "Return true if the download whose status is that described by +@var{uri-status} is still alive." + (let ((pid (assoc-ref uri-status 'pid)) + (downloader-pid (assoc-ref uri-status 'downloader-pid))) + (and (process-exists? pid) + (process-exists? downloader-pid)))) + +(define (start-file-download downloader status-dir uri options) + "Dowload the file located at @var{uri}, with options @var{options} +and return an updated status alist." + (gnunet-debug "start-file-download") + (let ((uri-status (uri-status status-dir uri))) + (if (null? uri-status) + (acons 'start-date (current-time) + (start-downloader downloader uri options)) + (if (download-process-alive? uri-status) + (and (gnunet-info "~a already being downloaded by process ~a" + uri (assoc-ref uri-status 'pid)) + #f) + (and (gnunet-info "Resuming download") + (let ((start-date (assoc-ref uri-status 'start-date)) + (dir (assoc-ref uri-status 'working-directory)) + (options (assoc-ref uri-status 'options))) + (acons 'start-date start-date + (start-downloader downloader uri options + #:directory dir)))))))) + +(define *completed-download-hook* (make-hook 1)) + +(define (download-file downloader status-dir uri options) + "Start downloading file located at URI @var{uri}, with options +@var{options}, resuming it if it's already started." + (catch 'system-error + (lambda () + (and-let* ((status (start-file-download downloader + status-dir + uri options)) + (pid (assoc-ref status 'downloader-pid)) + (filename (uri-status-file-name status-dir + uri)) + (file (open-file filename "w"))) + + ;; Write down the status + (pretty-print status file) + (close-port file) + + ;; Wait for `gnunet-download' + (gnunet-info "Waiting for process ~a" pid) + (let* ((process-status (waitpid pid)) + (exit-val (status:exit-val (cdr process-status))) + (term-sig (status:term-sig (cdr process-status)))) + + ;; Terminate + (delete-file filename) + (gnunet-info + "Download completed (PID ~a, exit code ~a)" + pid exit-val) + (let ((ret `((end-date . ,(current-time)) + (exit-code . ,exit-val) + (terminating-signal . ,term-sig) + ,@status))) + (run-hook *completed-download-hook* ret) + ret)))) + (lambda (key . args) + (gnunet-error (exception-string key args))))) + +(define (uri-status-files directory) + "Return the list of URI status files in @var{directory}." + (catch 'system-error + (lambda () + (let ((dir (opendir directory))) + (let loop ((filename (readdir dir)) + (file-list '())) + (if (eof-object? filename) + file-list + (if (regexp-exec *uri-status-file-re* filename) + (loop (readdir dir) + (cons filename file-list)) + (loop (readdir dir) file-list)))))) + (lambda (key . args) + (gnunet-error (exception-string key args))))) + +(define (output-file-option option-list) + "Return the output file specified in @var{option-list}, false if +anavailable." + (if (null? option-list) + #f + (let ((rest (cdr option-list)) + (opt (car option-list))) + (if (null? rest) + #f + (if (or (string=? opt "-o") + (string=? opt "--output")) + (car rest) + (output-file-option rest)))))) + +(define (download-command . args) + "Start downloading a file using the given `gnunet-download' +arguments." + (gnunet-debug "download-command") + (let* ((argc (length args)) + ;; FIXME: We're assuming the URI is the last argument + (uri (car (list-tail args (- argc 1)))) + (options args)) + (download-file *gnunet-download* *status-directory* uri options))) + +(define (status-command . args) + "Print status info about files being downloaded." + (for-each (lambda (status) + (format #t "~a: ~a~% ~a~% ~a~% ~a~%" + (assoc-ref status 'uri) + (if (download-process-alive? status) + (string-append "running (PID " + (number->string (assoc-ref status + 'pid)) + ")") + "not running") + (string-append "Started on " + (strftime "%c" + (localtime (assoc-ref + status + 'start-date)))) + (string-append "Directory: " + (assoc-ref status + 'working-directory)) + (string-append "Output file: " + (or (output-file-option (assoc-ref + status + 'options)) + "")))) + (map (lambda (file) + (uri-status *status-directory* + (string-append "gnunet://fs/chk/" file))) + (uri-status-files *status-directory*)))) + +(define (resume-command . args) + "Resume stopped downloads." + (for-each (lambda (status) + (if (not (download-process-alive? status)) + (if (= 0 (primitive-fork)) + (let* ((ret (download-file *gnunet-download* + *status-directory* + (assoc-ref status 'uri) + (assoc-ref status 'options))) + (code (assoc-ref ret 'exit-code))) + (exit code))))) + (map (lambda (file) + (uri-status *status-directory* + (string-append "gnunet://fs/chk/" file))) + (uri-status-files *status-directory*)))) + +(define (killall-command . args) + "Stop all running downloads." + (for-each (lambda (status) + (if (download-process-alive? status) + (let ((pid (assoc-ref status 'pid)) + (dl-pid (assoc-ref status 'downloader-pid))) + (and (gnunet-info "Stopping processes ~a and ~a" + pid dl-pid) + (kill pid 15) + (kill dl-pid 15))))) + (map (lambda (file) + (uri-status *status-directory* + (string-append "gnunet://fs/chk/" file))) + (uri-status-files *status-directory*)))) + + +(define (help-command . args) + "Show this help message." + (format #t "Usage: ~a [options]~%" *program-name*) + (format #t "Where may be one of the following:~%~%") + (for-each (lambda (command) + (if (not (eq? (cdr command) help-command)) + (format #t (string-append " " (car command) ": " + (object-documentation + (cdr command)) + "~%")))) + *commands*) + (format #t "~%")) + +(define (settings-command . args) + "Dump the current settings." + (format #t "Current settings:~%~%") + (module-for-each (lambda (symbol variable) + (if (string-match "^\\*.*\\*$" (symbol->string symbol)) + (format #t " ~a: ~a~%" + symbol (variable-ref variable)))) + (current-module)) + (format #t "~%")) + +(define (version-command . args) + "Show version information." + (format #t "~a ~a.~a (~a)~%" + *program-name* *version-major* *version-minor* *version-date*)) + +;; This hook may be added to *completed-download-hook*. +(define (completed-download-notification-hook status) + "Notifies of the completion of a file download." + (let ((msg (string-append "GNUnet download of " + (output-file-option + (assoc-ref status 'options)) + " in " + (assoc-ref status + 'working-directory) + " complete!"))) + (if (getenv "DISPLAY") + (waitpid (fork-and-exec #f "xmessage" msg)) + (waitpid (fork-and-exec #f "write" + (cuserid) msg))))) + +;; Available user commands +(define *commands* + `(("download" . ,download-command) + ("status" . ,status-command) + ("resume" . ,resume-command) + ("killall" . ,killall-command) + ("settings" . ,settings-command) + ("version" . ,version-command) + ("help" . ,help-command) + ("--help" . ,help-command) + ("-h" . ,help-command))) + +(define *program-name* "gnunet-download-manager") +(define *version-major* 0) +(define *version-minor* 1) +(define *version-date* "april 2004") + +(define (main args) + (set! *program-name* (basename (car args))) + + ;; Load the user's configuration file + (if (file-exists? *rc-file*) + (load *rc-file*)) + + ;; Check whether the status directory already exists + (if (not (file-exists? *status-directory*)) + (begin + (gnunet-info "Creating status directory ~a..." *status-directory*) + (catch 'system-error + (lambda () + (mkdir *status-directory*)) + (lambda (key . args) + (and (gnunet-error (exception-string key args)) + (exit 1)))))) + + ;; Go ahead + (if (< (length args) 2) + (and (format #t "Usage: ~a [options]~%" + *program-name*) + (exit 1)) + (let* ((command-name (cadr args)) + (command (assoc-ref *commands* command-name))) + (if command + (apply command (cddr args)) + (and (gnunet-info "~a command not found" command-name) + (exit 1)))))) diff --git a/src/fs/Makefile.am b/src/fs/Makefile.am index 85ac37b83..80316dc2e 100644 --- a/src/fs/Makefile.am +++ b/src/fs/Makefile.am @@ -89,10 +89,6 @@ bin_PROGRAMS = \ gnunet-fs \ gnunet-unindex -#bin_SCRIPTS = \ -# gnunet-download-manager.scm -noinst_SCRIPTS = gnunet-download-manager.scm - gnunet_directory_SOURCES = \ gnunet-directory.c gnunet_directory_LDADD = \ @@ -574,7 +570,6 @@ EXTRA_DIST = \ test_gnunet_fs_idx.py.in \ test_gnunet_service_fs_migration_data.conf \ test_gnunet_service_fs_p2p_cadet.conf \ - test_pseudonym_data.conf \ - $(noinst_SCRIPTS) + test_pseudonym_data.conf CLEANFILES = $(check_SCRIPTS) diff --git a/src/fs/gnunet-download-manager.scm b/src/fs/gnunet-download-manager.scm deleted file mode 100755 index 0b4301cc8..000000000 --- a/src/fs/gnunet-download-manager.scm +++ /dev/null @@ -1,409 +0,0 @@ -#!/bin/sh -exec guile -e main -s "$0" "$@" -!# - -;;; gnunet-download-manager -- Manage GNUnet downloads. -;;; Copyright (C) 2004 Ludovic Courtès -;;; -;;; 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 2 -;;; 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, write to the Free Software -;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -;;; -;;; SPDX-License-Identifier: GPL-2.0-or-later - -;;; Remember ongoing GNUnet downloads so as to be able to resume them -;;; later. Typical usage is to define the following alias in your -;;; favorite shell: -;;; -;;; alias gnunet-download='gnunet-download-manager.scm download' -;;; -;;; You may have a ~/.gnunet-download-manager.scm Scheme configuration -;;; file. In particular, if you would like to be notified of -;;; completed downloads, you may want to add the following line to -;;; your configuration file: -;;; -;;; (add-hook! *completed-download-hook* -;;; completed-download-notification-hook) -;;; -;;; This script works fine with GNU Guile 1.6.4, and doesn't run with -;;; Guile 1.4.x. -;;; -;;; Enjoy! -;;; Ludovic Courtès - -(use-modules (ice-9 format) - (ice-9 optargs) - (ice-9 regex) - (ice-9 and-let-star) - (ice-9 pretty-print) - (ice-9 documentation)) - -;; Overall user settings -(define *debug?* #f) -(define *rc-file* (string-append (getenv "HOME") - "/.gnunet-download-manager.scm")) -(define *status-directory* (string-append (getenv "HOME") "/" - ".gnunet-download-manager")) -(define *gnunet-download* "gnunet-download") - -;; Helper macros -(define-macro (gnunet-info fmt . args) - `(format #t (string-append *program-name* ": " ,fmt "~%") - ,@args)) - -(define-macro (gnunet-debug fmt . args) - (if *debug?* - (cons 'gnunet-info (cons fmt args)) - #t)) - -(define-macro (gnunet-error fmt . args) - `(and ,(cons 'gnunet-info (cons fmt args)) - (exit 1))) - -(define (exception-string key args) - "Describe an error, using the format from @var{args}, if available." - (if (< (length args) 4) - (format #f "Scheme exception: ~S" key) - (string-append - (if (string? (car args)) - (string-append "In " (car args)) - "Scheme exception") - ": " - (apply format `(#f ,(cadr args) ,@(caddr args)))))) - - -;; Regexps matching GNUnet URIs -(define *uri-base* - "([[:alnum:]]+).([[:alnum:]]+).([[:alnum:]]+).([0-9]+)") -(define *uri-re* - (make-regexp (string-append "^gnunet://fs/chk/" *uri-base* "$") - regexp/extended)) -(define *uri-status-file-re* - (make-regexp (string-append "^" *uri-base* "$") - regexp/extended)) - - -(define (uri-status-file-name directory uri) - "Return the name of the status file for URI @var{uri}." - (let ((match (regexp-exec *uri-re* uri))) - (if (not match) - (and (gnunet-info "~a: Invalid URI" uri) #f) - (let ((start (match:start match 1)) - (end (match:end match 4))) - (string-append directory "/" - (substring uri start end)))))) - -(define (uri-status directory uri) - "Load the current status alist for URI @var{uri} from @var{directory}." - (gnunet-debug "uri-status") - (let ((filename (uri-status-file-name directory uri))) - (catch 'system-error - (lambda () - (let* ((file (open-input-file filename)) - (status (read file))) - (begin - (close-port file) - status))) - (lambda (key . args) - (and (gnunet-debug (exception-string key args)) - '()))))) - -(define (process-exists? pid) - (false-if-exception (begin (kill pid 0) #t))) - -(define (fork-and-exec directory program . args) - "Launch @var{program} and return its PID." - (gnunet-debug "fork-and-exec: ~a ~a" program args) - (let ((pid (primitive-fork))) - (if (= 0 pid) - (begin - (if directory (chdir directory)) - (apply execlp (cons program (cons program args)))) - pid))) - -(define* (start-downloader downloader uri options - #:key (directory #f)) - "Start the GNUnet downloader for URI @var{uri} with options -@var{options}. Return an alist describing the download status." - (catch 'system-error - (lambda () - (let* ((pid (apply fork-and-exec - `(,(if directory directory (getcwd)) - ,downloader - ,@options)))) - (gnunet-info "Launched process ~a" pid) - `((uri . ,uri) - (working-directory . ,(if directory directory (getcwd))) - (options . ,options) - (pid . ,(getpid)) - (downloader-pid . ,pid)))) - (lambda (key . args) - (gnunet-error (exception-string key args))))) - -(define (download-process-alive? uri-status) - "Return true if the download whose status is that described by -@var{uri-status} is still alive." - (let ((pid (assoc-ref uri-status 'pid)) - (downloader-pid (assoc-ref uri-status 'downloader-pid))) - (and (process-exists? pid) - (process-exists? downloader-pid)))) - -(define (start-file-download downloader status-dir uri options) - "Dowload the file located at @var{uri}, with options @var{options} -and return an updated status alist." - (gnunet-debug "start-file-download") - (let ((uri-status (uri-status status-dir uri))) - (if (null? uri-status) - (acons 'start-date (current-time) - (start-downloader downloader uri options)) - (if (download-process-alive? uri-status) - (and (gnunet-info "~a already being downloaded by process ~a" - uri (assoc-ref uri-status 'pid)) - #f) - (and (gnunet-info "Resuming download") - (let ((start-date (assoc-ref uri-status 'start-date)) - (dir (assoc-ref uri-status 'working-directory)) - (options (assoc-ref uri-status 'options))) - (acons 'start-date start-date - (start-downloader downloader uri options - #:directory dir)))))))) - -(define *completed-download-hook* (make-hook 1)) - -(define (download-file downloader status-dir uri options) - "Start downloading file located at URI @var{uri}, with options -@var{options}, resuming it if it's already started." - (catch 'system-error - (lambda () - (and-let* ((status (start-file-download downloader - status-dir - uri options)) - (pid (assoc-ref status 'downloader-pid)) - (filename (uri-status-file-name status-dir - uri)) - (file (open-file filename "w"))) - - ;; Write down the status - (pretty-print status file) - (close-port file) - - ;; Wait for `gnunet-download' - (gnunet-info "Waiting for process ~a" pid) - (let* ((process-status (waitpid pid)) - (exit-val (status:exit-val (cdr process-status))) - (term-sig (status:term-sig (cdr process-status)))) - - ;; Terminate - (delete-file filename) - (gnunet-info - "Download completed (PID ~a, exit code ~a)" - pid exit-val) - (let ((ret `((end-date . ,(current-time)) - (exit-code . ,exit-val) - (terminating-signal . ,term-sig) - ,@status))) - (run-hook *completed-download-hook* ret) - ret)))) - (lambda (key . args) - (gnunet-error (exception-string key args))))) - -(define (uri-status-files directory) - "Return the list of URI status files in @var{directory}." - (catch 'system-error - (lambda () - (let ((dir (opendir directory))) - (let loop ((filename (readdir dir)) - (file-list '())) - (if (eof-object? filename) - file-list - (if (regexp-exec *uri-status-file-re* filename) - (loop (readdir dir) - (cons filename file-list)) - (loop (readdir dir) file-list)))))) - (lambda (key . args) - (gnunet-error (exception-string key args))))) - -(define (output-file-option option-list) - "Return the output file specified in @var{option-list}, false if -anavailable." - (if (null? option-list) - #f - (let ((rest (cdr option-list)) - (opt (car option-list))) - (if (null? rest) - #f - (if (or (string=? opt "-o") - (string=? opt "--output")) - (car rest) - (output-file-option rest)))))) - -(define (download-command . args) - "Start downloading a file using the given `gnunet-download' -arguments." - (gnunet-debug "download-command") - (let* ((argc (length args)) - ;; FIXME: We're assuming the URI is the last argument - (uri (car (list-tail args (- argc 1)))) - (options args)) - (download-file *gnunet-download* *status-directory* uri options))) - -(define (status-command . args) - "Print status info about files being downloaded." - (for-each (lambda (status) - (format #t "~a: ~a~% ~a~% ~a~% ~a~%" - (assoc-ref status 'uri) - (if (download-process-alive? status) - (string-append "running (PID " - (number->string (assoc-ref status - 'pid)) - ")") - "not running") - (string-append "Started on " - (strftime "%c" - (localtime (assoc-ref - status - 'start-date)))) - (string-append "Directory: " - (assoc-ref status - 'working-directory)) - (string-append "Output file: " - (or (output-file-option (assoc-ref - status - 'options)) - "")))) - (map (lambda (file) - (uri-status *status-directory* - (string-append "gnunet://fs/chk/" file))) - (uri-status-files *status-directory*)))) - -(define (resume-command . args) - "Resume stopped downloads." - (for-each (lambda (status) - (if (not (download-process-alive? status)) - (if (= 0 (primitive-fork)) - (let* ((ret (download-file *gnunet-download* - *status-directory* - (assoc-ref status 'uri) - (assoc-ref status 'options))) - (code (assoc-ref ret 'exit-code))) - (exit code))))) - (map (lambda (file) - (uri-status *status-directory* - (string-append "gnunet://fs/chk/" file))) - (uri-status-files *status-directory*)))) - -(define (killall-command . args) - "Stop all running downloads." - (for-each (lambda (status) - (if (download-process-alive? status) - (let ((pid (assoc-ref status 'pid)) - (dl-pid (assoc-ref status 'downloader-pid))) - (and (gnunet-info "Stopping processes ~a and ~a" - pid dl-pid) - (kill pid 15) - (kill dl-pid 15))))) - (map (lambda (file) - (uri-status *status-directory* - (string-append "gnunet://fs/chk/" file))) - (uri-status-files *status-directory*)))) - - -(define (help-command . args) - "Show this help message." - (format #t "Usage: ~a [options]~%" *program-name*) - (format #t "Where may be one of the following:~%~%") - (for-each (lambda (command) - (if (not (eq? (cdr command) help-command)) - (format #t (string-append " " (car command) ": " - (object-documentation - (cdr command)) - "~%")))) - *commands*) - (format #t "~%")) - -(define (settings-command . args) - "Dump the current settings." - (format #t "Current settings:~%~%") - (module-for-each (lambda (symbol variable) - (if (string-match "^\\*.*\\*$" (symbol->string symbol)) - (format #t " ~a: ~a~%" - symbol (variable-ref variable)))) - (current-module)) - (format #t "~%")) - -(define (version-command . args) - "Show version information." - (format #t "~a ~a.~a (~a)~%" - *program-name* *version-major* *version-minor* *version-date*)) - -;; This hook may be added to *completed-download-hook*. -(define (completed-download-notification-hook status) - "Notifies of the completion of a file download." - (let ((msg (string-append "GNUnet download of " - (output-file-option - (assoc-ref status 'options)) - " in " - (assoc-ref status - 'working-directory) - " complete!"))) - (if (getenv "DISPLAY") - (waitpid (fork-and-exec #f "xmessage" msg)) - (waitpid (fork-and-exec #f "write" - (cuserid) msg))))) - -;; Available user commands -(define *commands* - `(("download" . ,download-command) - ("status" . ,status-command) - ("resume" . ,resume-command) - ("killall" . ,killall-command) - ("settings" . ,settings-command) - ("version" . ,version-command) - ("help" . ,help-command) - ("--help" . ,help-command) - ("-h" . ,help-command))) - -(define *program-name* "gnunet-download-manager") -(define *version-major* 0) -(define *version-minor* 1) -(define *version-date* "april 2004") - -(define (main args) - (set! *program-name* (basename (car args))) - - ;; Load the user's configuration file - (if (file-exists? *rc-file*) - (load *rc-file*)) - - ;; Check whether the status directory already exists - (if (not (file-exists? *status-directory*)) - (begin - (gnunet-info "Creating status directory ~a..." *status-directory*) - (catch 'system-error - (lambda () - (mkdir *status-directory*)) - (lambda (key . args) - (and (gnunet-error (exception-string key args)) - (exit 1)))))) - - ;; Go ahead - (if (< (length args) 2) - (and (format #t "Usage: ~a [options]~%" - *program-name*) - (exit 1)) - (let* ((command-name (cadr args)) - (command (assoc-ref *commands* command-name))) - (if command - (apply command (cddr args)) - (and (gnunet-info "~a command not found" command-name) - (exit 1)))))) -- cgit v1.2.3