Commit e00f1443 authored by Julien Lepiller's avatar Julien Lepiller

torrent: add (torrent tracker).

parent 07865407
......@@ -16,3 +16,4 @@ doc/version.texi
.dirstamp
mdate-sh
.guix-profile*
texinfo.tex
......@@ -4,6 +4,7 @@ SOURCES= \
torrent/utils/fixnums.scm \
torrent/utils/sha-1.scm \
torrent/bencoding.scm \
torrent/metainfo.scm
torrent/metainfo.scm \
torrent/tracker.scm
info_TEXINFOS= doc/guile-torrent.texi
......@@ -32,6 +32,7 @@ implementation of the bittorrent protocol.
@menu
* Encoding and decoding data::
* Managing .torrent files::
* Connecting to Trackers::
@end menu
@node Encoding and decoding data
......@@ -165,4 +166,128 @@ and returns a @code{metainfo} object containing the necessary information in
that file.
@end deffn
@node Connecting to Trackers
@chapter Connecting to Trackers
The @code{(torrent tracker)} module contains definitions and procedures that
deal with connecting to a tracker and getting information.
@deffn {Data Type} tracker
@table @asis
@item host
A string representing the host name of the tracker.
@item page
A string representing the path to the annouce page. e.g.@: @code{"/announce"}
@item proto
A string representing the protocol used to connect to the tracker. e.g.@:
@code{"http"}.
@item port
A number representing the port of the tracker, or @code{#f} to use the standard
port for the protocol.
@item infohash
The infohash of the torrent we are interested in, represented by a bytevector.
@item state
The current state of this session:
@itemize
@item @code{'start} indicates that we still haven't connected to the tracker
during this session;
@item @code{'complete} indicates that we have completed the download but haven't
talled the tracker yet;
@item @code{'stop} indicates that we are about to stop, but we haven't talled the
server yet;
@item @code{'running} indicates that we are operating normally.
@end itemize
@item uploaded
The number of bytes that we have uploaded during this session.
@item downloaded
The number of bytes that we have downloaded during this session.
@item left
The number of bytes left that we need to download.
@item id
The tracker id or @code{#f} if the tracker didn't send us its tracker id.
@end table
@end deffn
@deffn {Data Type} tracker-response
@table @asis
@item failure-reason
When an error occured, a string containing the reason of the failure. Otherwise
@code{#f}. If this field is set, no other field can be considered valid.
@item warning-message
When a warning is issued by the tracker, a string containing the content of
the warning. Otherwise @code{#f}.
@item interval
A number representing the interval in seconds at which the tracker would want us
to ask for more peers.
@item min-interval
A number representing the minimum interval in seconds the tracker wants us to
respect between two requests.
@item tracker-id
A string containing the tracker id. If no tracker id is given by the tracker,
@code{#f}. Otherwise, this value should be saved for future requests in the
@code{id} field of the @code{tracker} object.
@item complete
The number of peers the tracker knows of that have finished downloading the
torrent.
@item incomplete
The number of peers the tracker knows of that have not yet finished downloading
the torrent.
@item peers
A list of peers, each represented by an association list containing two fields:
@code{"host"} and @code{"port"}. The value of these fields are integers.
@end table
@end deffn
@deffn {Scheme Procedure} uri-proto @var{uri}
Returns the protocol part of the @var{uri}, e.g.@: @code{"http"}.
@end deffn
@deffn {Scheme Procedure} uri-host @var{uri}
Returns the host part of the @var{uri}.
@end deffn
@deffn {Scheme Procedure} uri-port @var{uri}
Returns the port part of the @var{uri} as a number or @code{#f} if it is not
specified in the @var{uri}.
@end deffn
@deffn {Scheme Procedure} uri-page @var{uri}
Returns the path part of the @var{uri}.
@end deffn
@deffn {Scheme Procedure} url-encode @var{bv}
This procedure takes a bytevector and returns the url-encoded value equivalent
to the content of the bytevector. This works by using the @code{%xx} encoding
for each character that cannot appear in a url.
@end deffn
@deffn {Scheme Procedure} ask-more-peers @var{tracker} @var{peerid} @var{port}
This procedure will ask @var{tracker} for more peers. @var{peerid} and @var{port}
must contain respectively the peer id and port of our client. This makes a
request to the tracker and returns a @code{tracker-response} object in case
of success or a simple string containing the body of the response in case of
error.
@end deffn
@deffn {Scheme Procedure} get-new-tracker @var{uri} @var{infohash} @var{left}
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
@bye
;;;; Copyright (C) 2018 Julien Lepiller <julien@lepiller.eu>
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;
(define-module (torrent tracker)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-9)
#:use-module (torrent bencoding)
#:use-module (web request)
#:use-module (web response)
#:use-module (web uri)
#:export (make-tracker
tracker?
tracker-url
tracker-proto
tracker-port
tracker-infohash
tracker-uploaded
tracker-downloaded
tracker-left
tracker-id
make-tracker-response
tracker-response?
tracker-response-failure-reason
tracker-response-warning-message
tracker-response-interval
tracker-response-min-interval
tracker-response-tracker-id
tracker-response-complete
tracker-response-incomplete
tracker-response-peers
uri-proto
uri-port
uri-host
uri-page
url-encode
get-new-tracker
ask-more-peers))
(define-record-type tracker
(make-tracker host page proto port infohash state uploaded downloaded left id)
tracker?
(host tracker-host)
(page tracker-page)
(proto tracker-proto)
(port tracker-port)
(infohash tracker-infohash)
(state tracker-state)
(uploaded tracker-uploaded)
(downloaded tracker-downloaded)
(left tracker-left)
(id tracker-id))
(define-record-type tracker-response
(make-tracker-response failure-reason warning-message interval min-interval
tracker-id complete incomplete peers)
tracker-response?
(failure-reason tracker-response-failure-reason)
(warning-message tracker-response-warning-message)
(interval tracker-response-interval)
(min-interval tracker-response-min-interval)
(tracker-id tracker-response-tracker-id)
(complete tracker-response-complete)
(incomplete tracker-response-incomplete)
(peers tracker-response-peers))
(define (uri-proto uri)
(car (string-split uri #\:)))
(define (uri-host uri)
(car (string-split
(substring (car (cdr (string-split uri #\:))) 2)
#\/)))
(define (uri-page uri)
(string-append
"/"
(string-join
(cdr (string-split
(substring (string-concatenate (cdr (string-split uri #\:))) 2)
#\/))
"/")))
(define (uri-port uri)
(match (cdr (string-split
(car
(string-split
(substring (string-join (cdr (string-split uri #\:)) ":") 2)
#\/)) #\:))
('() #f)
((port rest ...) (string->number port))))
(define (get-new-tracker uri infohash left)
(make-tracker (uri-host uri) (uri-page uri) (uri-proto uri) (uri-port uri)
infohash 'start 0 0 left #f))
(define (url-encode bv)
(string-concatenate
(map
(lambda (int) (with-output-to-string (lambda _ (format #t "%~2,'0X" int))))
(bytevector->u8-list bv))))
(define (parse-peers peers)
(match peers
((? bytevector? peers)
(begin
(let loop ((pos 0))
(if (< pos (bytevector-length peers))
(cons `(("host" . ,(bytevector-u32-ref peers pos (endianness big)))
("port" . ,(bytevector-u16-ref peers (+ pos 4) (endianness big))))
(loop (+ pos 6)))
'()))))))
(define (parse-tracker-response response)
(let ((response (dictionnary-alist response)))
(make-tracker-response
(assoc-ref response "failure reason")
(assoc-ref response "warning message")
(assoc-ref response "interval")
(assoc-ref response "min-interval")
(assoc-ref response "tracker id")
(assoc-ref response "complete")
(assoc-ref response "incomplete")
(parse-peers (assoc-ref response "peers")))))
(define (ask-more-peers tracker peerid port)
(let* ((request (string-append
"compact=1&"
"info_hash=" (url-encode (tracker-infohash tracker)) "&"
"peer_id=" (url-encode peerid) "&"
"port=" (number->string port) "&"
"uploaded=" (number->string (tracker-uploaded tracker)) "&"
"downloaded=" (number->string (tracker-downloaded tracker)) "&"
"left=" (number->string (tracker-left tracker)) "&"
(match (tracker-state tracker)
('start "event=started")
('complete "event=completed")
('stop "event=stopped")
(_ ""))
(if (tracker-id tracker)
(string-append "&trackerid=" (tracker-id tracker))
"")))
(uri (build-uri
(match (tracker-proto tracker)
("http" 'http)
("https" 'https))
#:port (tracker-port tracker)
#:host (tracker-host tracker)
#:path (tracker-page tracker)
#:query request))
(port (tracker-port tracker))
(info (car (getaddrinfo (tracker-host tracker)
(if port
(number->string port)
(tracker-proto tracker))
(if port
AI_NUMERICSERV
0))))
(sock (socket (addrinfo:fam info) SOCK_STREAM IPPROTO_IP)))
(connect sock (addrinfo:addr info))
(write-request (build-request uri) sock)
(let* ((response (read-response sock))
(ans (bdecode (response-port response))))
(close-port sock)
(if (eq? (response-code response) 200)
(parse-tracker-response ans)
(list uri response)))))
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