Commit bbd10e73 authored by Julien Lepiller's avatar Julien Lepiller

torrent: Add bitfield and channel management in peer.

* torrent/protocol.scm (peer, receive-message, update-peer): Manage
bitfield and channel.
* doc/torrent.texi (protocol): Document.
parent 8f0e3cc1
......@@ -310,6 +310,9 @@ A 20-bytes bytevector holding the peer-id of the remote peer.
@item sock
The socket through which to communicate with the peer.
@item bitfield
A bitfield representing the availability of pieces from that peer.
@item choking
A boolean indicating whether the remote peer choked us. When we are choked,
we shouldn't request blocks to that peer.
......@@ -326,6 +329,9 @@ choking it, it shouldn't ask
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.
@item channel
A @code{guile-fibers} channel.
@end table
@end deffn
......@@ -334,8 +340,17 @@ remote peer will not likely unchoke us unless it is aware we are interested.
This procedure generates a 20-bytes peer-id.
@end deffn
@deffn {Scheme Procedure} update-peer @var{peer} [#:options @var{id} @
@var{sock} @var{bitfield} @var{choking} @
@var{interested} @var{am-choking} @
@var{am-interested} @var{channel}]
This procedure returns an updated record for peer with the same content for
fields of @var{peer}, but updating values of the corresponding optional
arguments that were given.
@end deffn
@deffn {Scheme Procedure} get-new-peer @var{host} @var{port} @
[#:options (@var{id} @code{#f}]
[#: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}.
......
......@@ -20,15 +20,18 @@
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (fibers channels)
#:export (make-peer
peer?
peer-id
peer-sock
peer-bitfield
peer-choking
peer-interested
peer-am-choking
peer-am-interested
peer-channel
generate-id
get-new-peer
update-peer
......@@ -48,29 +51,33 @@
send-port))
(define-record-type peer
(make-peer id sock choking interested am-choking am-interested)
(make-peer id sock bitfield choking interested am-choking am-interested channel)
peer?
(id peer-id)
(sock peer-sock)
(bitfield peer-bitfield)
(choking peer-choking)
(interested peer-interested)
(am-choking peer-am-choking)
(am-interested peer-am-interested))
(am-interested peer-am-interested)
(channel peer-channel))
(define* (update-peer peer
#:key
(id (peer-id peer)) (sock (peer-sock peer))
(bitfield (peer-bitfield 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))
(am-interested (peer-am-interested peer))
(channel (peer-channel peer)))
(make-peer id sock bitfield choking interested am-choking am-interested channel))
(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)))
(make-peer id sock #f #t #f #t #f (make-channel))))
(define (random-alphanum-char)
(let ((r (random 127)))
......@@ -108,7 +115,8 @@ it is made readable in this format: -<two-letter program id><four-digits version
(equal? (utf8->string proto) "BitTorrent protocol")
(equal? infohash rinfohash))
(begin
(make-peer rpeerid (peer-sock peer) #t #f #t #f))
(make-peer rpeerid (peer-sock peer) (peer-bitfield peer)
#t #f #t #f (peer-channel peer)))
(begin
(close (peer-sock peer))
peer))))
......@@ -138,10 +146,11 @@ it is made readable in this format: -<two-letter program id><four-digits version
(update-peer peer #:interested #f)))
(4 (let ((piece (bytevector-u32-ref msg 1 (endianness big))))
(format #t "Received have ~d~%" piece)
peer))
(5 (begin
(format #t "Received bitfield ~a~%" msg)
peer))
(update-peer peer #:bitfield (has (peer-bitfield peer) piece))))
(5 (let ((bitfield (make-bytevector (- len 1) 0)))
(bytevector-copy! msg 1 bitfield 0 (- len 1))
(format #t "Received bitfield ~a~%" bitfield)
(update-peer peer #:bitfield bitfield)))
(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))))
......@@ -240,3 +249,19 @@ it is made readable in this format: -<two-letter program id><four-digits version
(msg (u8-list->bytevector `(0 0 0 3 9 0 0))))
(bytevector-u16-set! msg 5 listen-port (endianness big))
(put-bytevector port msg)))
(define (n-th-bit n num)
(if (eq? n 7) (mod num 2) (n-th-bit (+ n 1) (div num 2))))
(define (has? bv piece)
(n-th-bit (mod piece 8) (bytevector-u8-ref bv (div piece 8))))
(define (update-bit n num)
(if (eq? n 7)
(+ 1 (* 2 (div num 2)))
(+ (mod num 2) (* 2 (update-bit (+ n 1) (div num 2))))))
(define (has bv piece)
(bytevector-u8-set!
bv (div piece 8)
(update-bit (mod piece 8) (bytevector-u8-ref bv (div piece 8)))))
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