Paste: magnet uri stuff

USING: accessors arrays assocs calendar combinators destructors
fry io io.binary io.encodings.binary io.encodings.string
io.encodings.utf8 io.sockets io.sockets.private
io.streams.byte-array io.timeouts kernel math.parser namespaces
pack prettyprint random sequences splitting tools.hexdump
urls.encoding ;
IN: magnet-uris

CONSTANT: SIMPSONS-URI "xt=urn:btih:1eda58a2ec8bc7edc776aaf8e66895d20d2e99cb&dn=The.Simpsons.S26E22.HDTV.x264-LOL%5Bettv%5D&tr=udp%3A%2F%2Ftracker.openbittorrent.com%3A80&tr=udp%3A%2F%2Fopen.demonii.com%3A1337&tr=udp%3A%2F%2Ftracker.coppersurfer.tk%3A6969&tr=udp%3A%2F%2Fexodus.desync.com%3A6969"

CONSTANT: LAST-WEEK-TONIGHT-URI "magnet:?xt=urn:btih:102c2cf6849162f99aaad217363895cebeab82ef&dn=Last+Week+Tonight+With+John+Oliver+S03E01+720p+HDTV+x264-BATV+%5Beztv%5D&tr=udp%3A%2F%2Ftracker.coppersurfer.tk%3A6969%2Fannounce&tr=udp%3A%2F%2Ftracker.openbittorrent.com%3A80%2Fannounce&tr=udp%3A%2F%2Fglotorrents.pw%3A6969%2Fannounce&tr=udp%3A%2F%2Ftracker.publicbt.com%3A80%2Fannounce&tr=http%3A%2F%2Ftracker.trackerfix.com%2Fannounce&tr=udp%3A%2F%2Ftracker.opentrackr.org%3A1337%2Fannounce&tr=udp%3A%2F%2F9.rarbg.me%3A2710%2Fannounc"

TUPLE: announce-response action transaction-id interval leechers seeders peeps ;

: parse-announce-response ( byte-array -- obj )
    [ announce-response new ] dip binary [
        4 read be> >>action
        4 read be> >>transaction-id
        4 read be> >>interval
        4 read be> >>leechers
        4 read be> >>seeders

        dup seeders>> [
            4 read [ number>string ] { } map-as "." join
            2 read be> 2array
        ] { } replicate-as [ { "" 0 } = ] trim-tail >>peeps

        "leftover: " print contents hexdump.
    ] with-byte-reader ;

ERROR: unsupported-uri string ;

ERROR: bad-host ;

: uri>inet4 ( string -- inet4 )
    "udp://" ?head [
        ":" split1 "/" split1 drop
        [ resolve-host [ bad-host ] [ [ ipv4? ] filter random host>> ] if-empty ]
        [ string>number ] bi* <inet4>
    ] [
        unsupported-uri
    ] if ;

ERROR: can't-parse-magnet-hash assoc ;
: magnet>hash ( assoc -- hash )
    {
        { [ dup "xt" of ] [ "xt" of ":" split last ] }
        { [ dup "magnet:?xt" of ] [ "magnet:?xt" of ":" split last ] }
        [ can't-parse-magnet-hash ]
    } cond ;

SYMBOL: magnet-assoc
SYMBOL: magnet-hash

: query-udp-tracker ( magnet-uri -- inet4 datagram data hash )
    query>assoc magnet-assoc set
    magnet-assoc get "tr" of random uri>inet4
    ! "tracker.coppersurfer.tk" resolve-host random host>> 6969 <inet4>
    [
        3 seconds over set-timeout

        ! Connect request
        0x41727101980
        0
        32 random-bits 3array dup . "QII" pack-be 2over send

        ! read
        dup receive drop "IIQ" unpack-be third
        ! "QII20c20cQQQIIIISS"
        [ binary ] dip '[
            _ 8 >be write
            1 4 >be write ! 1 = announce
            4 random-bytes write

            ! "1eda58a2ec8bc7edc776aaf8e66895d20d2e99cb" hex> 20 >be write
            ! magnet-assoc get "xt" of ":" split last hex> 20 >be write
            magnet-assoc get magnet>hash hex> 20 >be dup magnet-hash set-global write

            "M4-20-8" 20 0 pad-tail utf8 encode write
            0 8 >be write ! downloaded
            0 8 >be write ! left
            0 8 >be write ! uploaded

            0 4 >be write ! event 0,1,2,3; none,completed,started,stopped
            0 4 >be write ! ip, 0 for default
            4 random-bytes write ! unique random key
            -1 4 >be write ! num_want -1 default

            dup addr>> port>> 2 >be write
            ! 0 2 >be write
        ] with-byte-writer

        2over send
        dup receive drop
        dup hexdump.
        parse-announce-response
        magnet-hash get-global

    ] with-random-local-datagram ;


: tcp0 ( inet4 hash -- obj )
    [ binary ] dip '[
        binary [
            "BitTorrent protocol" [ length write1 ] [ utf8 encode write ] bi
            B{ 0 0 0 0 0 10 0 05 } write
            ! B{ 0 0 0 0 0 0 0 0 } write
            _ write
            "It's me, MarkJuggler" utf8 encode write
        ] with-byte-writer
        write flush
        4 read be> read
        ! 49 read
        ! 1000 read-partial
    ] with-client ;