Commit f6ae6f23 authored by Julien Lepiller's avatar Julien Lepiller

torrent: Add (torrent protocol).

parent 2155d503
......@@ -5,6 +5,7 @@ SOURCES= \
torrent/utils/sha-1.scm \
torrent/bencoding.scm \
torrent/metainfo.scm \
torrent/protocol.scm \
info_TEXINFOS= doc/guile-torrent.texi
......@@ -33,6 +33,7 @@ implementation of the bittorrent protocol.
* Encoding and decoding data::
* Managing .torrent files::
* Connecting to Trackers::
* Sending and Receiving Messages::
@end menu
@node Encoding and decoding data
......@@ -198,8 +199,8 @@ The current state of this session:
@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
told the tracker yet;
@item @code{'stop} indicates that we are about to stop, but we haven't told the
server yet;
@item @code{'running} indicates that we are operating normally.
@end itemize
......@@ -290,4 +291,128 @@ 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
@node Sending and Receiving Messages
@chapter Sending and Receiving Messages
The @code{(torrent protocol)} module is responsible for handling protocol
messages and connecting to peers.
@deffn {Data Type} peer
This data type represents a peer in the bittorrent protocol. A peer is another
client running the bittorrent protocol that either has the file we are interested
in or is interested in the file. This record type has the following fields:
@table @asis
@item id
A 20-bytes bytevector holding the peer-id of the remote peer.
@item sock
The socket through which to communicate with the peer.
@item choking
A boolean indicating whether the remote peer choked us. When we are choked,
we shouldn't request blocks to that peer.
@item interested
A boolean indicating whether the remote peer is interested by what we have. If
we wante to send it data, we should unchok it first.
@item am-choking
A boolean indicating whether we are choking the remote peer. While we are
choking it, it shouldn't ask
@item am-interested
A boolean indicating whether we told the remote peer we were interested. The
remote peer will not likely unchoke us unless it is aware we are interested.
@end table
@end deffn
@deffn {Scheme Procedure} generate-id
This procedure generates a 20-bytes peer-id.
@end deffn
@deffn {Scheme Procedure} get-new-peer @var{host} @var{port} @
[#:options (@var{id} @code{#f}]
This procedure connects to a peer specified by @var{host} and @var{port} and
returns a new peer object. The @code{id} field is filled with the value of
the optional argument @var{id}.
@end deffn
@deffn {Scheme Procedure} send-handshake @var{peer} @var{infohash} @var{self-id}
This procedure sends a handshake message to @var{peer}. The handshake must be
the first message sent to the peer. It specifies the @var{infohash} and our
@var{self-id} (peer id).
@end deffn
@deffn {Scheme Procedure} receive-handshake @var{peer} @var{infohash}
This procedure waits for the handshake of the @var{peer} and compares its content
with the @var{infohash} we are interested in. If the handshake is valid, returns
an updated @code{peer} object.
@end deffn
@deffn {Scheme Procedure} receive-message @var{peer}
This procedure waits for a message from the @var{peer} and decodes it. If it
is a valid message, returns an updated @code{peer} object. It prints the
message and its content to the standard output.
@end deffn
@deffn {Scheme Procedure} send-keep-alive @var{peer}
This procedure sends a keep-alive message. These messages must be sent from time
to time because peers will close the connection after typically 2 minutes of
@end deffn
@deffn {Sceme Procedure} send-choke @var{peer}
This procedure sends a message to choke the remote @var{peer}. It should not
ask us for pieces anymore.
@end deffn
@deffn {Scheme Procedure} send-unchoke @var{peer}
This procedure send a message to unchoke the remote @var{peer}. It can now
request pieces from us.
@end deffn
@deffn {Scheme Procedure} send-interested @var{peer}
Tell the remote @var{peer} we are interested.
@end deffn
@deffn {Scheme Procedure} send-not-interested @var{peer}
Tell the remote @var{peer} we are not interested.
@end deffn
@deffn {Scheme Procedure} send-have @var{peer} @var{piece}
Notify the @var{peer} we have completed download of @var{piece}, the zero-based
index of the piece.
@end deffn
@deffn {Scheme Procedure} send-bitfield @var{peer} @var{bitfield}
Send a @var{bitfield} to the @var{peer} to tell it what pieces we already have
or not. This is not required if we don't have any piece yet. This procedure
should only be used once after the handshake and before sending any other
@end deffn
@deffn {Scheme Procedure} send-request @var{peer} @var{index} @var{start} @var{len}
Ask @var{peer} for a part of a piece of size @var{len}, starting at offset
@var{start} in the @var{index} piece. A typical value for @var{len} is 16384.
@end deffn
@deffn {Scheme Procedure} send-piece @var{peer} @var{index} @var{start} @var{block}
Send a block of data to the @var{peer}. This block corresponds to the @var{index}
piece at offset @var{start}. This should be used after a peer asked us for a
@end deffn
@deffn {Scheme Procedure} send-cancel @var{peer} @var{index} @var{start} @var{len}
Ask the @var{peer} to cancel sending the piece to us. The other arguments are
the same as for the @code{send-request} procedure.
@end deffn
@deffn {Scheme Procedure} send-port @var{peer} @var{listen-port}
Send the @var{listen-port} we are listening on for the DHT protocol.
@end deffn
;;;; Copyright (C) 2018 Julien Lepiller <>
;;;; 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
;;;; 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 client)
#:use-module (srfi srfi-9)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:export (make-peer
(define-record-type peer
(make-peer id sock choking interested am-choking am-interested)
(id peer-id)
(sock peer-sock)
(choking peer-choking)
(interested peer-interested)
(am-choking peer-am-choking)
(am-interested peer-am-interested))
(define* (update-peer peer
(id (peer-id peer)) (sock (peer-sock peer))
(choking (peer-choking peer))
(interested (peer-interested peer))
(am-choking (peer-am-choking peer))
(am-interested (peer-am-interested peer)))
(make-peer id sock choking interested am-choking am-interested))
(define* (get-new-peer host port #:optional id)
(let* ((info (car (getaddrinfo host (number->string port))))
(sock (socket (addrinfo:fam info) SOCK_STREAM IPPROTO_IP)))
(connect sock (addrinfo:addr info))
(make-peer id sock #t #f #t #f)))
(define (random-alphanum-char)
(let ((r (random 127)))
(if (char-set-contains? char-set:letter+digit (integer->char r))
(integer->char r)
(define (generate-id)
"Generate our own peer id. A peer id is a random 20-bytes string. Usually,
it is made readable in this format: -<two-letter program id><four-digits version>-<12 alphanumerical characters>."
(string-append "-GT0001-"
(let loop ((sz 0))
(if (< sz 12)
(cons (random-alphanum-char) (loop (+ 1 sz)))
(define (send-handshake peer infohash self-id)
(let ((handshake (make-bytevector 68)))
(bytevector-u8-set! handshake 0 19)
(bytevector-copy! (string->utf8 "BitTorrent protocol") 0 handshake 1 19)
(bytevector-copy! infohash 0 handshake 28 20)
(bytevector-copy! self-id 0 handshake 48 20)
(put-bytevector (peer-sock peer) handshake)))
(define (receive-handshake peer infohash)
(let* ((handshake (get-bytevector-n (peer-sock peer) 68))
(proto (make-bytevector 19))
(rinfohash (make-bytevector 20))
(rpeerid (make-bytevector 20)))
(bytevector-copy! handshake 1 proto 0 19)
(bytevector-copy! handshake 28 rinfohash 0 20)
(bytevector-copy! handshake 48 rpeerid 0 20)
(if (and (equal? (bytevector-u8-ref handshake 0) 19)
(equal? (utf8->string proto) "BitTorrent protocol")
(equal? infohash rinfohash))
(make-peer rpeerid (peer-sock peer) #t #f #t #f))
(close (peer-sock peer))
(define (receive-message peer)
(let* ((len (bytevector-u32-ref (get-bytevector-n (peer-sock peer) 4) 0 (endianness big)))
(msg (if (eq? len 0) #f (get-bytevector-n (peer-sock peer) len))))
(if (eq? len 0)
(format #t "Received keep-alive.")
(if (eq? (bytevector-length msg) len)
(let ((id (bytevector-u8-ref msg 0)))
(match id
(0 (begin
(format #t "Received choke~%")
(update-peer peer #:choking #t)))
(1 (begin
(format #t "Received unchoke~%")
(update-peer peer #:choking #f)))
(2 (begin
(format #t "Received interested~%")
(update-peer peer #:interested #t)))
(3 (begin
(format #t "Received not interested~%")
(update-peer peer #:interested #f)))
(4 (let ((piece (bytevector-u32-ref msg 1 (endianness big))))
(format #t "Received have ~d~%" piece)
(5 (begin
(format #t "Received bitfield ~a~%" msg)
(6 (let ((index (bytevector-u32-ref msg 1 (endianness big)))
(start (bytevector-u32-ref msg 5 (endianness big)))
(len (bytevector-u32-ref msg 9 (endianness big))))
(format #t "Received request index ~d begin ~d length ~d~%"
index start len)
(7 (let ((index (bytevector-u32-ref msg 1 (endianness big)))
(start (bytevector-u32-ref msg 5 (endianness big)))
(block (make-bytevector (- len 9))))
(bytevector-copy! msg 9 block 0 (- len 9))
(format #t "Received piece index ~d begin ~d block ~a~%"
index start block)
(8 (let ((index (bytevector-u32-ref msg 1 (endianness big)))
(start (bytevector-u32-ref msg 5 (endianness big)))
(len (bytevector-u32-ref msg 9 (endianness big))))
(format #t "Received cancel index ~d begin ~d length ~d~%"
index start len)
(9 (let ((port (bytevector-u16-ref msg 1 (endianness big))))
(format #t "Received port ~d~%" port)
(format #t "Size mismatch?~%"))))))
(define (send-keep-alive peer)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector '(0))))
(put-bytevector port msg)))
(define (send-choke peer)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector '(0 0 0 1 1))))
(put-bytevector port msg)))
(define (send-unchoke peer)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector '(0 0 0 1 2))))
(put-bytevector port msg)))
(define (send-interested peer)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector '(0 0 0 1 3))))
(put-bytevector port msg)))
(define (send-not-interested peer)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector '(0 0 0 1 4))))
(put-bytevector port msg)))
(define (send-have peer piece)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector '(0 0 0 0 5 5 0 0 0 0))))
(bytevector-u32-set! msg 6 piece (endianness big))
(put-bytevector port msg)))
(define (send-bitfield peer bitfield)
(let ((port (peer-sock peer))
(msg (make-bytevector (+ (bytevector-length bitfield) 5))))
(bytevector-u32-set! msg 0 (+ (bytevector-length bitfield) 1) (endianness big))
(bytevector-u8-set! msg 4 5)
(bytevector-copy! bitfield 0 msg 6 (bytevector-length bitfield))
(put-bytevector port msg)))
(define (send-request peer index start len)
(let ((port (peer-sock peer))
(msg (make-bytevector 17)))
(bytevector-u32-set! msg 0 13 (endianness big))
(bytevector-u8-set! msg 4 6)
(bytevector-u32-set! msg 5 index (endianness big))
(bytevector-u32-set! msg 9 start (endianness big))
(bytevector-u32-set! msg 13 len (endianness big))
(put-bytevector port msg)))
(define (send-piece peer index start block)
(let ((port (peer-sock peer))
(msg (make-bytevector (+ (bytevector-length block) 13))))
(bytevector-u32-set! msg 0 (+ (bytevector-length block) 9) (endianness big))
(bytevector-u8-set! msg 4 7)
(bytevector-u32-set! msg 5 index (endianness big))
(bytevector-u32-set! msg 9 start (endianness big))
(bytevector-copy! block 0 msg 13 (bytevector-length block))
(put-bytevector port msg)))
(define (send-cancel peer index start len)
(let ((port (peer-sock peer))
(msg (make-bytevector 17)))
(bytevector-u32-set! msg 0 13 (endianness big))
(bytevector-u8-set! msg 4 8)
(bytevector-u32-set! msg 5 index (endianness big))
(bytevector-u32-set! msg 9 start (endianness big))
(bytevector-u32-set! msg 13 len (endianness big))
(put-bytevector port msg)))
(define (send-port peer listen-port)
(let ((port (peer-sock peer))
(msg (u8-list->bytevector `(0 0 0 3 9 0 0))))
(bytevector-u16-set! msg 5 listen-port (endianness big))
(put-bytevector port msg)))
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