[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[GNUnet-SVN] r19169 - in gnunet: doc/man src/fs
|
From: |
gnunet |
|
Subject: |
[GNUnet-SVN] r19169 - in gnunet: doc/man src/fs |
|
Date: |
Mon, 16 Jan 2012 00:40:19 +0100 |
Author: grothoff
Date: 2012-01-16 00:40:19 +0100 (Mon, 16 Jan 2012)
New Revision: 19169
Added:
gnunet/doc/man/gnunet-download-manager.1
gnunet/src/fs/gnunet-download-manager.scm
Modified:
gnunet/doc/man/Makefile.am
gnunet/src/fs/Makefile.am
Log:
adding Ludo's gnunet-download-manager.scm back to SVN HEAD
Modified: gnunet/doc/man/Makefile.am
===================================================================
--- gnunet/doc/man/Makefile.am 2012-01-15 20:44:50 UTC (rev 19168)
+++ gnunet/doc/man/Makefile.am 2012-01-15 23:40:19 UTC (rev 19169)
@@ -2,6 +2,7 @@
gnunet-arm.1 \
gnunet-directory.1 \
gnunet-download.1 \
+ gnunet-download-manager.1 \
gnunet-fs.1 \
gnunet-nat-server.1 \
gnunet-peerinfo.1 \
Added: gnunet/doc/man/gnunet-download-manager.1
===================================================================
--- gnunet/doc/man/gnunet-download-manager.1 (rev 0)
+++ gnunet/doc/man/gnunet-download-manager.1 2012-01-15 23:40:19 UTC (rev
19169)
@@ -0,0 +1,24 @@
+.TH GNUNET-DOWNLOAD-MANAGER 1 "15 Jan, 2011" "GNUnet"
+
+.SH NAME
+gnunet-download-manager \- manage downloads across sessions
+
+.SH SYNOPSIS
+.B gnunet\-download\-manager
+.RI [ options ]
+.br
+
+.SH DESCRIPTION
+\fBgnunet\-download\-manager\fP is a script that can be used to track download
sessions. It makes the process of resuming downloads after a system reboot
easier. A typical use is to define an alias (depending on your shell) of the
form
+
+$ alias gnunet\-download='gnunet\-download\-manager.scm download'
+
+Other commands for the download manager include resume (resumes all
downloads), status (show status of pending downloads), killall (abort all
downloads), settings (for configuration) and help (print help text).
+
+gnunet\-download\-manager is a scheme script and will only work if guile is
available.
+
+.SH BUGS
+Report bugs by using mantis <https://gnunet.org/bugs/> or by sending
electronic mail to <address@hidden>
+
+.SH SEE ALSO
+gnunet\-download(1)
Modified: gnunet/src/fs/Makefile.am
===================================================================
--- gnunet/src/fs/Makefile.am 2012-01-15 20:44:50 UTC (rev 19168)
+++ gnunet/src/fs/Makefile.am 2012-01-15 23:40:19 UTC (rev 19169)
@@ -67,6 +67,9 @@
gnunet-fs \
gnunet-unindex
+bin_SCRIPTS = \
+ gnunet-download-manager.scm
+
gnunet_directory_SOURCES = \
gnunet-directory.c
gnunet_directory_LDADD = \
Added: gnunet/src/fs/gnunet-download-manager.scm
===================================================================
--- gnunet/src/fs/gnunet-download-manager.scm (rev 0)
+++ gnunet/src/fs/gnunet-download-manager.scm 2012-01-15 23:40:19 UTC (rev
19169)
@@ -0,0 +1,407 @@
+#!/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., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; 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 <address@hidden>
+
+(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://afs/" *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
address@hidden 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
address@hidden 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
address@hidden, 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))
+ "<unknown>"))))
+ (map (lambda (file)
+ (uri-status *status-directory*
+ (string-append "gnunet://afs/" 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://afs/" 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://afs/" file)))
+ (uri-status-files *status-directory*))))
+
+
+(define (help-command . args)
+ "Show this help message."
+ (format #t "Usage: ~a <command> [options]~%" *program-name*)
+ (format #t "Where <command> 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 <command> [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))))))
\ No newline at end of file
Property changes on: gnunet/src/fs/gnunet-download-manager.scm
___________________________________________________________________
Added: svn:executable
+ *
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [GNUnet-SVN] r19169 - in gnunet: doc/man src/fs,
gnunet <=