Commit 9e348b30 authored by Julien Lepiller's avatar Julien Lepiller

torrent: Add tracker-fiber.

* torrent/tracker.scm (tracker-fiber): New procedure.
* doc/guile-torrent.texi: Document it.
parent 723c6af9
......@@ -291,6 +291,17 @@ This method can be used to initialize all the fields of a new @code{tracker}
object. It returns this new @code{tracker} object.
@end deffn
@deffn {Scheme Procedure} tracker-fiber @var{tracker} @var{peerid} @var{port} @
@var{infohash} @var{ending-channel} @var{peers-channel}
This procedures runs a fiber that connects to the given @var{tracker}.
@var{peerid} and @var{port} are our peer ID and port on which we are listening
for connections. @var{ending-channel} is a channel on which the fiber listens
from the @code{'stop} message. @var{peers-channel} is a channel on which the
fiber will put messages about newly found peers. Messages from this fiber
are always of this form:
@code{`(("type" 'new-peers) ("new-peers" <tracker-response-peers>))}.
@end deffn
@node Sending and Receiving Messages
@chapter Sending and Receiving Messages
......
......@@ -16,10 +16,12 @@
;;;;
(define-module (torrent tracker)
#:use-module (fibers channels)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-9)
#:use-module (torrent bencoding)
#:use-module (torrent utils fibers)
#:use-module (web request)
#:use-module (web response)
#:use-module (web uri)
......@@ -54,7 +56,9 @@
url-encode
get-new-tracker
ask-more-peers))
ask-more-peers
tracker-fiber))
(define-record-type tracker
(make-tracker host page proto port infohash state uploaded downloaded left id)
......@@ -191,3 +195,43 @@
(if (eq? (response-code response) 200)
(parse-tracker-response ans)
(list uri response)))))
(define (tracker-fiber tracker peerid port infohash ending-channel peers-channel)
(lambda ()
(let ((tracker (get-new-tracker tracker infohash 1000)))
(let loop ((tracker tracker))
(let* ((response (ask-more-peers tracker peerid port))
(tracker
(make-tracker
(tracker-host tracker)
(tracker-page tracker)
(tracker-proto tracker)
(tracker-port tracker)
(tracker-infohash tracker)
(tracker-state tracker)
(tracker-uploaded tracker)
(tracker-downloaded tracker)
(tracker-left tracker)
(if (tracker-response-tracker-id response)
(tracker-response-tracker-id response)
(tracker-id tracker))))
(timer (if (tracker-response-interval response)
(tracker-response-interval response)
300)))
(if (not (tracker-response-failure-reason response))
(put-message
peers-channel
(list
(cons "type" 'new-peers)
(cons "new-peers" (tracker-response-peers response))))
(format #t "Error while connecting to tracker: ~a~%"
(utf8->string (tracker-response-failure-reason response))))
(if (tracker-response-warning-message response)
(format #t "Warning: ~a~%" (tracker-response-warning-message response)))
(let ((timeout-channel (make-channel)))
(match
(timeout-perform-operation
timer
(get-operation ending-channel))
('stop #t)
('timeout (loop tracker)))))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment