core: subseq-index? -> subseq-of?

[factor.git] / extra / bittorrent / bittorrent.factor

diff --git a/extra/bittorrent/bittorrent.factor b/extra/bittorrent/bittorrent.factor
index b9b1f5c3192db71cfdd2cb77629355fb4f09c4e2..624544575eb0cb25d111261d944a6ccc8da65369 100644 (file)
--- a/extra/bittorrent/bittorrent.factor
+++ b/extra/bittorrent/bittorrent.factor
@@ -1,22 +1,21 @@
 ! Copyright (C) 2020 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 USING: accessors arrays assocs bencode byte-arrays byte-vectors
-calendar checksums checksums.sha combinators destructors fry
-grouping http.client io io.binary io.encodings.binary io.files
+calendar checksums checksums.sha combinators destructors endian
+grouping http.client io io.encodings.binary io.files
 io.pathnames io.sockets io.streams.byte-array io.streams.duplex
-kernel literals locals make math math.bitwise math.functions
-math.order math.parser math.ranges multiline namespaces
-prettyprint random sequences splitting strings timers
-tools.annotations ui ui.gadgets.panes ui.tools.listener urls ;
+kernel literals make math math.bitwise math.functions math.order
+math.parser namespaces random ranges sequences splitting strings
+timers ui ui.gadgets.panes ui.tools.listener urls ;
 
 IN: bittorrent
 
 <<
 CONSTANT: ALPHANUMERIC $[
     [
-        CHAR: a CHAR: z [a,b] %
-        CHAR: A CHAR: Z [a,b] %
-        CHAR: 0 CHAR: 9 [a,b] %
+        CHAR: a CHAR: z [a..b] %
+        CHAR: A CHAR: Z [a..b] %
+        CHAR: 0 CHAR: 9 [a..b] %
         ".-_~" %
     ] { } make
 ]
@@ -74,7 +73,7 @@ M: string load-metainfo
     dup "announce-list" of [ nip first random ] [ "announce" of ] if* ;
 
 : scrape-url ( metainfo -- url/f )
-    announce-url "announce" over path>> subseq? [
+    announce-url dup path>>  "announce" subseq-of? [
         [ "announce" "scrape" replace ] change-path
     ] [ drop f ] if ;
 
@@ -99,6 +98,24 @@ M: string load-metainfo
         ]
     } cleave ;
 
+TUPLE: magnet display-name exact-length exact-topic
+web-seed acceptable-source exact-source keyword-topic
+manifest-topic address-tracker ;
+
+: magnet-link>magnet ( url -- magnet-url )
+    [ magnet new ] dip
+    >url query>> {
+        [ "dn" of >>display-name ]
+        [ "xl" of >>exact-length ]
+        [ "xt" of >>exact-topic ]
+        [ "ws" of >>web-seed ]
+        [ "as" of >>acceptable-source ]
+        [ "xs" of >>exact-source ]
+        [ "kt" of >>keyword-topic ]
+        [ "mt" of >>manifest-topic ]
+        [ "tr" of >>address-tracker ]
+    } cleave ;
+
 : parse-peer4 ( peerbin -- inet4 )
     4 cut [
         [ number>string ] { } map-as "." join
@@ -408,7 +425,7 @@ M: peer dispose
 :: next-block ( peer -- peer )
     peer current-index>> [ 1 + ] [ 0 ] if*
     peer #pieces>>
-    peer bitfield>> '[ _ check-bitfield ] (find-integer)
+    peer bitfield>> '[ _ check-bitfield ] find-integer-from
     peer current-index<<
     0 peer current-piece>> set-length
     peer ;
@@ -470,14 +487,4 @@ M:: piece handle-message ( peer message -- peer )
     peer request-piece ;
 
 : read-messages ( peer -- peer )
-    [ read-message dup ] [ handle-message ] while drop ;
-
-
-\ write-message [
-    '[ [ "write-message: " write dup . ] with-debug @ ]
-] annotate
-
-
-\ handle-message [
-    '[ [ "handle-message: " write dup . ] with-debug @ ]
-] annotate
+    [ read-message ] [ handle-message ] while* ;