torrent (empty) → 2007.6.24
raw patch · 7 files changed
+413/−0 lines, 7 filesdep +FilePathdep +basedep +bencodebuild-type:Customsetup-changed
Dependencies added: FilePath, base, bencode, network
Files
- LICENSE +35/−0
- Setup.hs +2/−0
- cbits/sha1.c +166/−0
- src/Data/Torrent.hs +91/−0
- src/Data/Torrent/SHA1.hs +32/−0
- src/Data/Torrent/Scrape.hs +68/−0
- torrent.cabal +19/−0
+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2005-2007, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++ * Redistributions of source code must retain+ the above copyright notice, this list of+ conditions and the following disclaimer.+ * Redistributions in binary form must reproduce+ the above copyright notice, this list of+ conditions and the following disclaimer in the+ documentation and/or other materials provided+ with the distribution.+ * Neither the name of David Himmelstrup nor the+ names of other contributors may be used to+ endorse or promote products derived from this+ software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ cbits/sha1.c view
@@ -0,0 +1,166 @@+/*+ * sha1.c+ *+ * Originally witten by Steve Reid <steve@edmweb.com>+ * + * Modified by Aaron D. Gifford <agifford@infowest.com>+ *+ * NO COPYRIGHT - THIS IS 100% IN THE PUBLIC DOMAIN+ *+ * The original unmodified version is available at:+ * ftp://ftp.funet.fi/pub/crypt/hash/sha/sha1.c+ *+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND CONTRIBUTORS ``AS IS'' AND+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR(S) OR CONTRIBUTORS BE LIABLE+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+ * SUCH DAMAGE.+ */++#include "sha1.h"+#include <string.h>++#define rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits))))++/* blk0() and blk() perform the initial expand. */+/* I got the idea of expanding during the round function from SSLeay */++#ifdef LITTLE_ENDIAN+#define blk0(i) (block->l[i] = (rol(block->l[i],24)&(sha1_quadbyte)0xFF00FF00) \+ |(rol(block->l[i],8)&(sha1_quadbyte)0x00FF00FF))+#else+#define blk0(i) block->l[i]+#endif++#define blk(i) (block->l[i&15] = rol(block->l[(i+13)&15]^block->l[(i+8)&15] \+ ^block->l[(i+2)&15]^block->l[i&15],1))++/* (R0+R1), R2, R3, R4 are the different operations used in SHA1 */+#define R0(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk0(i)+0x5A827999+rol(v,5);w=rol(w,30);+#define R1(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk(i)+0x5A827999+rol(v,5);w=rol(w,30);+#define R2(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0x6ED9EBA1+rol(v,5);w=rol(w,30);+#define R3(v,w,x,y,z,i) z+=(((w|x)&y)|(w&x))+blk(i)+0x8F1BBCDC+rol(v,5);w=rol(w,30);+#define R4(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0xCA62C1D6+rol(v,5);w=rol(w,30);++typedef union _BYTE64QUAD16 {+ sha1_byte c[64];+ sha1_quadbyte l[16];+} BYTE64QUAD16;++/* Utility function for easy use in Haskell */+void SHA1(sha1_byte *data, unsigned int len, sha1_byte digest[SHA1_DIGEST_LENGTH])+{+ SHA_CTX context;+ SHA1_Init(&context);+ SHA1_Update(&context,data,len);+ SHA1_Final(digest,&context);+}++/* Hash a single 512-bit block. This is the core of the algorithm. */+void SHA1_Transform(sha1_quadbyte state[5], sha1_byte buffer[64]) {+ sha1_quadbyte a, b, c, d, e;+ BYTE64QUAD16 *block;++ block = (BYTE64QUAD16*)buffer;+ /* Copy context->state[] to working vars */+ a = state[0];+ b = state[1];+ c = state[2];+ d = state[3];+ e = state[4];+ /* 4 rounds of 20 operations each. Loop unrolled. */+ R0(a,b,c,d,e, 0); R0(e,a,b,c,d, 1); R0(d,e,a,b,c, 2); R0(c,d,e,a,b, 3);+ R0(b,c,d,e,a, 4); R0(a,b,c,d,e, 5); R0(e,a,b,c,d, 6); R0(d,e,a,b,c, 7);+ R0(c,d,e,a,b, 8); R0(b,c,d,e,a, 9); R0(a,b,c,d,e,10); R0(e,a,b,c,d,11);+ R0(d,e,a,b,c,12); R0(c,d,e,a,b,13); R0(b,c,d,e,a,14); R0(a,b,c,d,e,15);+ R1(e,a,b,c,d,16); R1(d,e,a,b,c,17); R1(c,d,e,a,b,18); R1(b,c,d,e,a,19);+ R2(a,b,c,d,e,20); R2(e,a,b,c,d,21); R2(d,e,a,b,c,22); R2(c,d,e,a,b,23);+ R2(b,c,d,e,a,24); R2(a,b,c,d,e,25); R2(e,a,b,c,d,26); R2(d,e,a,b,c,27);+ R2(c,d,e,a,b,28); R2(b,c,d,e,a,29); R2(a,b,c,d,e,30); R2(e,a,b,c,d,31);+ R2(d,e,a,b,c,32); R2(c,d,e,a,b,33); R2(b,c,d,e,a,34); R2(a,b,c,d,e,35);+ R2(e,a,b,c,d,36); R2(d,e,a,b,c,37); R2(c,d,e,a,b,38); R2(b,c,d,e,a,39);+ R3(a,b,c,d,e,40); R3(e,a,b,c,d,41); R3(d,e,a,b,c,42); R3(c,d,e,a,b,43);+ R3(b,c,d,e,a,44); R3(a,b,c,d,e,45); R3(e,a,b,c,d,46); R3(d,e,a,b,c,47);+ R3(c,d,e,a,b,48); R3(b,c,d,e,a,49); R3(a,b,c,d,e,50); R3(e,a,b,c,d,51);+ R3(d,e,a,b,c,52); R3(c,d,e,a,b,53); R3(b,c,d,e,a,54); R3(a,b,c,d,e,55);+ R3(e,a,b,c,d,56); R3(d,e,a,b,c,57); R3(c,d,e,a,b,58); R3(b,c,d,e,a,59);+ R4(a,b,c,d,e,60); R4(e,a,b,c,d,61); R4(d,e,a,b,c,62); R4(c,d,e,a,b,63);+ R4(b,c,d,e,a,64); R4(a,b,c,d,e,65); R4(e,a,b,c,d,66); R4(d,e,a,b,c,67);+ R4(c,d,e,a,b,68); R4(b,c,d,e,a,69); R4(a,b,c,d,e,70); R4(e,a,b,c,d,71);+ R4(d,e,a,b,c,72); R4(c,d,e,a,b,73); R4(b,c,d,e,a,74); R4(a,b,c,d,e,75);+ R4(e,a,b,c,d,76); R4(d,e,a,b,c,77); R4(c,d,e,a,b,78); R4(b,c,d,e,a,79);+ /* Add the working vars back into context.state[] */+ state[0] += a;+ state[1] += b;+ state[2] += c;+ state[3] += d;+ state[4] += e;+ /* Wipe variables */+ a = b = c = d = e = 0;+}+++/* SHA1_Init - Initialize new context */+void SHA1_Init(SHA_CTX* context) {+ /* SHA1 initialization constants */+ context->state[0] = 0x67452301;+ context->state[1] = 0xEFCDAB89;+ context->state[2] = 0x98BADCFE;+ context->state[3] = 0x10325476;+ context->state[4] = 0xC3D2E1F0;+ context->count[0] = context->count[1] = 0;+}++/* Run your data through this. */+void SHA1_Update(SHA_CTX *context, sha1_byte *data, unsigned int len) {+ unsigned int i, j;++ j = (context->count[0] >> 3) & 63;+ if ((context->count[0] += len << 3) < (len << 3)) context->count[1]++;+ context->count[1] += (len >> 29);+ if ((j + len) > 63) {+ memcpy(&context->buffer[j], data, (i = 64-j));+ SHA1_Transform(context->state, context->buffer);+ for ( ; i + 63 < len; i += 64) {+ SHA1_Transform(context->state, &data[i]);+ }+ j = 0;+ }+ else i = 0;+ memcpy(&context->buffer[j], &data[i], len - i);+}+++/* Add padding and return the message digest. */+void SHA1_Final(sha1_byte digest[SHA1_DIGEST_LENGTH], SHA_CTX *context) {+ sha1_quadbyte i, j;+ sha1_byte finalcount[8];++ for (i = 0; i < 8; i++) {+ finalcount[i] = (sha1_byte)((context->count[(i >= 4 ? 0 : 1)]+ >> ((3-(i & 3)) * 8) ) & 255); /* Endian independent */+ }+ SHA1_Update(context, (sha1_byte *)"\200", 1);+ while ((context->count[0] & 504) != 448) {+ SHA1_Update(context, (sha1_byte *)"\0", 1);+ }+ /* Should cause a SHA1_Transform() */+ SHA1_Update(context, finalcount, 8);+ for (i = 0; i < SHA1_DIGEST_LENGTH; i++) {+ digest[i] = (sha1_byte)+ ((context->state[i>>2] >> ((3-(i & 3)) * 8) ) & 255);+ }+ /* Wipe variables */+ i = j = 0;+ memset(context->buffer, 0, SHA1_BLOCK_LENGTH);+ memset(context->state, 0, SHA1_DIGEST_LENGTH);+ memset(context->count, 0, 8);+ memset(&finalcount, 0, 8);+}+
+ src/Data/Torrent.hs view
@@ -0,0 +1,91 @@+module Data.Torrent+ ( Torrent(..)+ , TorrentInfo(..)+ , TorrentFile(..)+ , readTorrent -- :: ByteString -> Either String Torrent+ , torrentSize -- :: Torrent -> Int+ ) where++-- import Network.URI++import Data.BEncode+import Data.BEncode.Parser+import System.FilePath+import Data.Torrent.SHA1++import qualified Data.ByteString.Char8 as BS+import Data.ByteString (ByteString)++data Torrent+ = Torrent+ { tAnnounce :: String+ , tAnnounceList :: [String]+ , tComment :: String+ , tCreatedBy :: Maybe String+ , tInfo :: TorrentInfo+ , tInfoHash :: ByteString+ } deriving Show++data TorrentInfo+ = SingleFile+ { tLength :: Int+ , tName :: String+ , tPieceLength :: Int+ , tPieces :: ByteString }+ | MultiFile+ { tFiles :: [TorrentFile]+ , tName :: String+ , tPieceLength :: Int+ , tPieces :: ByteString+ } deriving Show++data TorrentFile+ = TorrentFile+ { fileLength :: Int+ , filePath :: FilePath+ } deriving Show+++torrentSize :: Torrent -> Int+torrentSize torrent+ = case tInfo torrent of+ s@SingleFile{} -> tLength s+ MultiFile{tFiles=files} -> sum (map fileLength files)++{-+buri :: BParser BEncode -> BParser URI+buri p = do str <- bstring p+ case parseURI str of+ Nothing -> fail $ "Expected URI: " ++ str+ Just uri -> return uri+-}++readTorrent :: ByteString -> Either String Torrent+readTorrent inp+ = case bRead inp of+ Nothing -> Left "Not BEncoded"+ Just be -> runParser parseTorrent be++parseTorrent :: BParser Torrent+parseTorrent =+ do announce <- bstring $ dict "announce"+ creator <- optional $ bstring $ dict "created by"+ info <- dict "info"+ setInput info+ name <- bstring $ dict "name"+ pLen <- bint $ dict "piece length"+ pieces <- bfaststring $ dict "pieces"+ torrentInfo <- parseTorrentInfo name pLen pieces+ let infoHash = sha1 (BS.pack $ bShow info "")+ return $ Torrent announce [] "" creator torrentInfo infoHash++parseTorrentInfo :: String -> Int -> ByteString -> BParser TorrentInfo+parseTorrentInfo name pLen pieces+ = do len <- bint $ dict "length"+ return $ SingleFile len name pLen pieces+ <|>+ do files <- list "files" $ do len <- bint $ dict "length"+ filePaths <- list "path" $ bstring token+ return $ TorrentFile len (foldr1 (</>) filePaths)+ return $ MultiFile files name pLen pieces+
+ src/Data/Torrent/SHA1.hs view
@@ -0,0 +1,32 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Torrent.SHA1+-- Copyright : (c) Lemmih 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : experimental+-- Portability : portable+--+-----------------------------------------------------------------------------+module Data.Torrent.SHA1 (sha1) where++import Foreign+import Foreign.C+import System.IO.Unsafe++import qualified Data.ByteString as BS+import qualified Data.ByteString.Base as BS+import Data.ByteString (ByteString)++--void SHA1(sha1_byte *data, unsigned int len, sha1_byte digest[SHA1_DIGEST_LENGTH]);+foreign import ccall safe "SHA1" c_sha1 :: CString -> Int -> CString -> IO ()++sha1 :: ByteString -> ByteString+sha1 fs = unsafePerformIO $+ BS.unsafeUseAsCString fs $ \cstr ->+ do ret <- mallocBytes 20+ c_sha1 cstr (BS.length fs) ret+ fp <- newForeignPtr finalizerFree (castPtr ret)+ return (BS.fromForeignPtr fp 20)+
+ src/Data/Torrent/Scrape.hs view
@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Torrent.SHA1+-- Copyright : (c) Lemmih 2005+-- License : BSD-like+--+-- Maintainer : lemmih@gmail.com+-- Stability : experimental+-- Portability : portable+--+-----------------------------------------------------------------------------+module Data.Torrent.Scrape+ ( ScrapeInfo(..)+ , parseScrapeInfo+ , scrapeUrl+ ) where++import Data.Char+import Data.BEncode+import qualified Data.ByteString.Char8 as BS+import Data.ByteString (ByteString)+import System.FilePath+import qualified Data.Map as Map++data ScrapeInfo = ScrapeInfo+ { scrapeSeeds :: Int+ , scrapeLeechers :: Int+ } deriving (Read,Show)++parseScrapeInfo :: ByteString -> Maybe ScrapeInfo+parseScrapeInfo bs+ = case bRead bs of+ Just (BDict dict)+ -> do BDict files <- Map.lookup "files" dict+ [BDict dict'] <- return (Map.elems files)+ BInt seeders <- Map.lookup "complete" dict'+ BInt peers <- Map.lookup "incomplete" dict'+ return $ ScrapeInfo+ { scrapeSeeds = seeders+ , scrapeLeechers = peers }+ _ -> Nothing++scrapeUrl :: ByteString -> [String] -> Maybe String+scrapeUrl _hash [] = Nothing+scrapeUrl hash (announce:rs)+ = case splitFileName announce of+ (path,file_)+ | (file,ext) <- splitExtension file_+ , ("announce",rest) <- break (=='?') file+ -> let info_hash = urlEncode (BS.unpack hash)+ file' = "scrape" ++ if null rest+ then "?info_hash="++info_hash+ else "&info_hash="++info_hash+ in Just (path </> file' <.> ext)+ _ -> scrapeUrl hash rs++urlEncode :: String -> String+urlEncode [] = []+urlEncode s = foldr worker [] s+ where worker c cs =+ if isReservedChar c then let (a, b) = ord c `divMod` 16+ in '%' : intToDigit a : intToDigit b : cs+ else c : cs+ isReservedChar x =+ x < '0' || x > '9' && x < 'A' || x > 'Z'+ && x < 'a' || x > 'z'++
+ torrent.cabal view
@@ -0,0 +1,19 @@+Name: torrent+Version: 2007.6.24+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com)+Copyright: 2005-2007, Lemmih+License-File: LICENSE+License: BSD3+Build-Depends: base, bencode, FilePath, network+Category: Network+Synopsis: BitTorrent file parser.+Tested-with: GHC ==6.6+Extensions: ForeignFunctionInterface, PatternGuards+Exposed-Modules:+ Data.Torrent+ Data.Torrent.Scrape+ Data.Torrent.SHA1+GHC-Options: -Wall -Werror+Hs-Source-Dirs: src+C-Sources: cbits/sha1.c