TorAddress.hs

-- |Addresses within Tor. TODO/FIXME: Fix everything about this module.
module Tor.DataFormat.TorAddress(
         TorAddress(..),    putTorAddress,    getTorAddress
       , unTorAddress
       , torAddressByteString
       , ip4ToString, ip6ToString
       , putIP4String, putIP6String
       )
 where

import Control.Monad
import Data.Bits
import Data.ByteString(ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Char8(pack,unpack)
import Data.ByteString.Lazy(toStrict)
import Data.Binary.Get
import Data.Binary.Put
import Data.List(intercalate)
import Data.Word
import Numeric

-- |An abstract data type representing either an address or an address
-- processing error, used in a variety of Tor protocols.
data TorAddress = Hostname String -- ^A hostname, as usual.
                | IP4 String -- ^An IP4 address, as 'a.b.c.d', in decimal
                | IP6 String -- ^An IP6 adddress, as '[...]', in usual hex form
                | TransientError String -- ^A transient error occurred when
                                        -- performing some action. Try again.
                | NontransientError String -- ^A non-transient error occurred
                                           -- when performing some action. Do
                                           -- not try again, or you will annoy
                                           -- the dragon.
 deriving (Eq, Ord, Show)

-- |Turn a TorAddress into a string. Will result in an error for either of the
-- error options.
unTorAddress :: TorAddress -> String
unTorAddress (Hostname s) = s
unTorAddress (IP4 s) = s
unTorAddress (IP6 s) = s
unTorAddress _       = error "unTorAddress: invalid input."

-- |Parse a TorAddress off the wire.
getTorAddress :: Get TorAddress
getTorAddress =
  do atype <- getWord8
     len   <- getWord8
     value <- getByteString (fromIntegral len)
     case (atype, len) of
       (0x00, _)  -> return (Hostname (unpack value))
       (0x04, 4)  -> return (IP4 (ip4ToString value))
       (0x04, _)  -> return (TransientError "Bad length for IP4 address.")
       (0x06, 16) -> return (IP6 (ip6ToString value))
       (0x06, _)  -> return (TransientError "Bad length for IP6 address.")
       (0xF0, _)  -> return (TransientError "External transient error.")
       (0xF1, _)  -> return (NontransientError "External nontransient error.")
       (_,    _)  -> return (NontransientError ("Unknown address type: " ++ show atype))

-- |Turn a 32-bit ByteString containing an IP4 address into the normal String
-- version of that IP4 address.
ip4ToString :: ByteString -> String
ip4ToString bstr = intercalate "." (map show (BS.unpack bstr))

-- |Turn a normal 128-bit ByteString containing an IP6 address into the normal
-- String version of that IP6 address. Recall that for Tor, the normal String
-- version is wrapped in square braces ([0000:11111:...]).
ip6ToString :: ByteString -> String
ip6ToString bstr = "[" ++ intercalate ":" (run (BS.unpack bstr)) ++ "]"
 where
  run :: [Word8] -> [String]
  run []         = []
  run [_]        = ["ERROR"]
  run (a:b:rest) =
    let a' = fromIntegral a :: Word16
        b' = fromIntegral b :: Word16
        v  = (a' `shiftL` 8) .|. b'
    in (showHex v "" : run rest)

-- |A putter for TorAddresses.
putTorAddress :: TorAddress -> Put
putTorAddress (Hostname str) =
  do putWord8 0x00
     let bstr = pack str
     putWord8 (fromIntegral (BS.length bstr))
     putByteString bstr
putTorAddress (IP4 str) =
  do putWord8     0x04
     putWord8     4
     putIP4String str
putTorAddress (IP6 str) =
  do putWord8 0x06
     putWord8 16
     putIP6String str
putTorAddress (TransientError _) =
  do putWord8 0xF0
     putWord8 0
putTorAddress (NontransientError _) =
  do putWord8 0xF1
     putWord8 0

-- |Given a normally-formatted IP4 String (a.b.c.d), turn that into a 32-bit
-- ByteString containing that IP address.
putIP4String :: String -> Put
putIP4String str = forM_ (unintercalate '.' str) (putWord8 . read)

-- |Given a normally-formatted IP6 String ([aaaa:bbbb:...]), turn that into a
-- 128-bit ByteString containing that IP address. Note that this function does
-- not support IP6 address compression ([aaaa::bbbbb]), so this must be a
-- fully-expanded address.
putIP6String :: String -> Put
putIP6String str =
  do let str' = unwrapIP6 str
     forM_ (unintercalate ':' str') $ \ v ->
       case readHex v of
        []        -> fail "Couldn't read IP6 address component."
        ((x,_):_) -> putWord16be x

-- |Translate a TorAddress into a ByteString.
torAddressByteString :: TorAddress -> ByteString
torAddressByteString (IP4 x) = 
  toStrict (runPut (forM_ (unintercalate '.' x) (putWord8 . read)))
torAddressByteString (IP6 x) =
  toStrict $ runPut $ forM_ (unintercalate ':' (unwrapIP6 x)) $ \ v ->
    case readHex v of
      []        -> fail "Couldn't read IP6 addr component."
      ((w,_):_) -> putWord16be w
torAddressByteString _ = error "Can't turn error into bytestring."

unintercalate :: Char -> String -> [String]
unintercalate _ "" = []
unintercalate c str =
  let (first, rest) = span (/= c) str
  in first : (unintercalate c (drop 1 rest))

unwrapIP6 :: String -> String
unwrapIP6 ('[':rest) =
  case reverse rest of
    (']':rrest) -> reverse rrest
    _ -> error ("IPv6 not in wrapped format (2): [" ++ rest)
unwrapIP6 x          = error ("IPv6 not in wrapped format: " ++ x)