{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TupleSections #-}
module System.IO.Streams.Network.HAProxy
(
behindHAProxy
, behindHAProxyWithLocalInfo
, decodeHAProxyHeaders
, ProxyInfo
, socketToProxyInfo
, makeProxyInfo
, getSourceAddr
, getDestAddr
, getFamily
, getSocketType
) where
import Control.Applicative ((<|>))
import Control.Monad (void, when)
import Data.Attoparsec.ByteString (anyWord8)
import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, skipWhile, string, take, takeWhile1)
import Data.Bits (unsafeShiftR, (.&.))
import qualified Data.ByteString as S8
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Unsafe as S
import Data.Word (Word16, Word32, Word8)
import Foreign.C.Types (CUInt (..), CUShort (..))
import Foreign.Ptr (castPtr)
import Foreign.Storable (peek)
import qualified Network.Socket as N
import Prelude hiding (take)
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Attoparsec as Streams
import System.IO.Streams.Network.Internal.Address (getSockAddr)
import System.IO.Unsafe (unsafePerformIO)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
socketToProxyInfo :: N.Socket -> N.SockAddr -> IO ProxyInfo
socketToProxyInfo :: Socket -> SockAddr -> IO ProxyInfo
socketToProxyInfo Socket
s SockAddr
sa = do
SockAddr
da <- Socket -> IO SockAddr
N.getSocketName Socket
s
!SocketType
sty <- IO SocketType
getSockType
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
makeProxyInfo SockAddr
sa SockAddr
da (SockAddr -> Family
addrFamily SockAddr
sa) SocketType
sty
where
#if MIN_VERSION_network(2,7,0)
getSockType :: IO SocketType
getSockType = do
Int
c <- Socket -> SocketOption -> IO Int
N.getSocketOption Socket
s SocketOption
N.Type
case Int
c of
Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return SocketType
N.Stream
Int
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return SocketType
N.Datagram
Int
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"bad socket type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
c)
#else
getSockType = let (N.MkSocket _ _ sty _ _) = s in return sty
#endif
behindHAProxy :: N.Socket
-> N.SockAddr
-> (ProxyInfo
-> InputStream ByteString
-> OutputStream ByteString
-> IO a)
-> IO a
behindHAProxy :: forall a.
Socket
-> SockAddr
-> (ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a)
-> IO a
behindHAProxy Socket
socket SockAddr
sa ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a
m = do
ProxyInfo
pinfo <- Socket -> SockAddr -> IO ProxyInfo
socketToProxyInfo Socket
socket SockAddr
sa
(InputStream ByteString, OutputStream ByteString)
sockets <- Socket -> IO (InputStream ByteString, OutputStream ByteString)
Streams.socketToStreams Socket
socket
forall a.
ProxyInfo
-> (InputStream ByteString, OutputStream ByteString)
-> (ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a)
-> IO a
behindHAProxyWithLocalInfo ProxyInfo
pinfo (InputStream ByteString, OutputStream ByteString)
sockets ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a
m
behindHAProxyWithLocalInfo
:: ProxyInfo
-> (InputStream ByteString, OutputStream ByteString)
-> (ProxyInfo
-> InputStream ByteString
-> OutputStream ByteString
-> IO a)
-> IO a
behindHAProxyWithLocalInfo :: forall a.
ProxyInfo
-> (InputStream ByteString, OutputStream ByteString)
-> (ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a)
-> IO a
behindHAProxyWithLocalInfo ProxyInfo
localProxyInfo (InputStream ByteString
is, OutputStream ByteString
os) ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a
m = do
ProxyInfo
proxyInfo <- ProxyInfo -> InputStream ByteString -> IO ProxyInfo
decodeHAProxyHeaders ProxyInfo
localProxyInfo InputStream ByteString
is
ProxyInfo
-> InputStream ByteString -> OutputStream ByteString -> IO a
m ProxyInfo
proxyInfo InputStream ByteString
is OutputStream ByteString
os
decodeHAProxyHeaders :: ProxyInfo -> (InputStream ByteString) -> IO ProxyInfo
ProxyInfo
localProxyInfo InputStream ByteString
is0 = do
InputStream ByteString
is <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
Streams.throwIfProducesMoreThan Int64
536 InputStream ByteString
is0
(!Bool
isOld, !Maybe (ByteString, Int, ByteString, Int, Family)
mbOldInfo) <- forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream
(((Bool
True,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe (ByteString, Int, ByteString, Int, Family))
parseOldHaProxy)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, forall a. Maybe a
Nothing)) InputStream ByteString
is
if Bool
isOld
then forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ProxyInfo
localProxyInfo)
(\(ByteString
srcAddr, Int
srcPort, ByteString
destAddr, Int
destPort, Family
f) -> do
(Family
_, SockAddr
s) <- Int -> ByteString -> IO (Family, SockAddr)
getSockAddr Int
srcPort ByteString
srcAddr
(Family
_, SockAddr
d) <- Int -> ByteString -> IO (Family, SockAddr)
getSockAddr Int
destPort ByteString
destAddr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
makeProxyInfo SockAddr
s SockAddr
d Family
f forall a b. (a -> b) -> a -> b
$ ProxyInfo -> SocketType
getSocketType ProxyInfo
localProxyInfo)
Maybe (ByteString, Int, ByteString, Int, Family)
mbOldInfo
else forall r. Parser r -> InputStream ByteString -> IO r
Streams.parseFromStream (ProxyInfo -> Parser ProxyInfo
parseNewHaProxy ProxyInfo
localProxyInfo) InputStream ByteString
is
data ProxyInfo = ProxyInfo {
ProxyInfo -> SockAddr
_sourceAddr :: N.SockAddr
, ProxyInfo -> SockAddr
_destAddr :: N.SockAddr
, ProxyInfo -> Family
_family :: N.Family
, ProxyInfo -> SocketType
_sockType :: N.SocketType
} deriving (Int -> ProxyInfo -> ShowS
[ProxyInfo] -> ShowS
ProxyInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ProxyInfo] -> ShowS
$cshowList :: [ProxyInfo] -> ShowS
show :: ProxyInfo -> [Char]
$cshow :: ProxyInfo -> [Char]
showsPrec :: Int -> ProxyInfo -> ShowS
$cshowsPrec :: Int -> ProxyInfo -> ShowS
Show)
getFamily :: ProxyInfo -> N.Family
getFamily :: ProxyInfo -> Family
getFamily ProxyInfo
p = ProxyInfo -> Family
_family ProxyInfo
p
getSocketType :: ProxyInfo -> N.SocketType
getSocketType :: ProxyInfo -> SocketType
getSocketType ProxyInfo
p = ProxyInfo -> SocketType
_sockType ProxyInfo
p
getSourceAddr :: ProxyInfo -> N.SockAddr
getSourceAddr :: ProxyInfo -> SockAddr
getSourceAddr ProxyInfo
p = ProxyInfo -> SockAddr
_sourceAddr ProxyInfo
p
getDestAddr :: ProxyInfo -> N.SockAddr
getDestAddr :: ProxyInfo -> SockAddr
getDestAddr ProxyInfo
p = ProxyInfo -> SockAddr
_destAddr ProxyInfo
p
makeProxyInfo :: N.SockAddr
-> N.SockAddr
-> N.Family
-> N.SocketType
-> ProxyInfo
makeProxyInfo :: SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
makeProxyInfo SockAddr
srcAddr SockAddr
destAddr Family
f SocketType
st = SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
ProxyInfo SockAddr
srcAddr SockAddr
destAddr Family
f SocketType
st
parseFamily :: Parser (Maybe N.Family)
parseFamily :: Parser (Maybe Family)
parseFamily = (ByteString -> Parser ByteString
string ByteString
"TCP4" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Family
N.AF_INET))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"TCP6" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Family
N.AF_INET6))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"UNKNOWN" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
parseOldHaProxy :: Parser (Maybe (ByteString, Int, ByteString, Int, N.Family))
parseOldHaProxy :: Parser (Maybe (ByteString, Int, ByteString, Int, Family))
parseOldHaProxy = do
ByteString -> Parser ByteString
string ByteString
"PROXY "
Maybe Family
gotFamily <- Parser (Maybe Family)
parseFamily
case Maybe Family
gotFamily of
Maybe Family
Nothing -> (Char -> Bool) -> Parser ()
skipWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\r') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString
string ByteString
"\r\n" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(Just Family
f) -> do
Char -> Parser Char
char Char
' '
ByteString
srcAddress <- (Char -> Bool) -> Parser ByteString
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
' ')
Char -> Parser Char
char Char
' '
ByteString
destAddress <- (Char -> Bool) -> Parser ByteString
takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
' ')
Char -> Parser Char
char Char
' '
Int
srcPort <- forall a. Integral a => Parser a
decimal
Char -> Parser Char
char Char
' '
Int
destPort <- forall a. Integral a => Parser a
decimal
ByteString -> Parser ByteString
string ByteString
"\r\n"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! (ByteString
srcAddress, Int
srcPort, ByteString
destAddress, Int
destPort, Family
f)
protocolHeader :: ByteString
= [Word8] -> ByteString
S8.pack [ Word8
0x0D, Word8
0x0A, Word8
0x0D, Word8
0x0A, Word8
0x00, Word8
0x0D
, Word8
0x0A, Word8
0x51, Word8
0x55, Word8
0x49, Word8
0x54, Word8
0x0A ]
{-# NOINLINE protocolHeader #-}
parseNewHaProxy :: ProxyInfo -> Parser ProxyInfo
parseNewHaProxy :: ProxyInfo -> Parser ProxyInfo
parseNewHaProxy ProxyInfo
localProxyInfo = do
ByteString -> Parser ByteString
string ByteString
protocolHeader
Word8
versionAndCommand <- Parser Word8
anyWord8
let version :: Word8
version = (Word8
versionAndCommand forall a. Bits a => a -> a -> a
.&. Word8
0xF0) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4
let command :: Word8
command = (Word8
versionAndCommand forall a. Bits a => a -> a -> a
.&. Word8
0xF) :: Word8
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
version forall a. Eq a => a -> a -> Bool
/= Word8
0x2) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid protocol version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
version
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
command forall a. Ord a => a -> a -> Bool
> Word8
1) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid command: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
command
Word8
protocolAndFamily <- Parser Word8
anyWord8
let family :: Word8
family = (Word8
protocolAndFamily forall a. Bits a => a -> a -> a
.&. Word8
0xF0) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4
let protocol :: Word8
protocol = (Word8
protocolAndFamily forall a. Bits a => a -> a -> a
.&. Word8
0xF) :: Word8
SocketType
socketType <- forall {a} {m :: * -> *}.
(Eq a, Num a, MonadFail m) =>
a -> m SocketType
toSocketType Word8
protocol
Word16
addressLen <- Word16 -> Word16
ntohs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
snarf16
case () of
!()
_ | Word8
command forall a. Eq a => a -> a -> Bool
== Word8
0x0 Bool -> Bool -> Bool
|| Word8
family forall a. Eq a => a -> a -> Bool
== Word8
0x0 Bool -> Bool -> Bool
|| Word8
protocol forall a. Eq a => a -> a -> Bool
== Word8
0x0
-> forall {a}. (Show a, Integral a) => a -> Parser ProxyInfo
handleLocal Word16
addressLen
| Word8
family forall a. Eq a => a -> a -> Bool
== Word8
0x1 -> forall {a}.
(Show a, Integral a) =>
a -> SocketType -> Parser ProxyInfo
handleIPv4 Word16
addressLen SocketType
socketType
| Word8
family forall a. Eq a => a -> a -> Bool
== Word8
0x2 -> forall {a}.
(Show a, Integral a) =>
a -> SocketType -> Parser ProxyInfo
handleIPv6 Word16
addressLen SocketType
socketType
#ifndef WINDOWS
| Word8
family forall a. Eq a => a -> a -> Bool
== Word8
0x3 -> forall {a}.
(Show a, Integral a) =>
a -> SocketType -> Parser ProxyInfo
handleUnix Word16
addressLen SocketType
socketType
#endif
| Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Bad family " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word8
family
where
toSocketType :: a -> m SocketType
toSocketType a
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SocketType
N.Stream
toSocketType a
1 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SocketType
N.Stream
toSocketType a
2 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SocketType
N.Datagram
toSocketType a
_ = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"bad protocol"
handleLocal :: a -> Parser ProxyInfo
handleLocal a
addressLen = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
addressLen forall a. Ord a => a -> a -> Bool
> a
500) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"suspiciously long address "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
addressLen
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
addressLen)
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyInfo
localProxyInfo
handleIPv4 :: a -> SocketType -> Parser ProxyInfo
handleIPv4 a
addressLen SocketType
socketType = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
addressLen forall a. Ord a => a -> a -> Bool
< a
12) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"bad address length "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
addressLen
forall a. [a] -> [a] -> [a]
++ [Char]
" for IPv4"
let nskip :: a
nskip = a
addressLen forall a. Num a => a -> a -> a
- a
12
Word32
srcAddr <- Parser Word32
snarf32
Word32
destAddr <- Parser Word32
snarf32
Word16
srcPort <- Word16 -> Word16
ntohs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
snarf16
Word16
destPort <- Word16 -> Word16
ntohs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
snarf16
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString
take forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nskip
let sa :: SockAddr
sa = PortNumber -> Word32 -> SockAddr
N.SockAddrInet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
srcPort) Word32
srcAddr
let sb :: SockAddr
sb = PortNumber -> Word32 -> SockAddr
N.SockAddrInet (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
destPort) Word32
destAddr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
makeProxyInfo SockAddr
sa SockAddr
sb (SockAddr -> Family
addrFamily SockAddr
sa) SocketType
socketType
handleIPv6 :: a -> SocketType -> Parser ProxyInfo
handleIPv6 a
addressLen SocketType
socketType = do
let scopeId :: Word32
scopeId = Word32
0
let flow :: Word32
flow = Word32
0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
addressLen forall a. Ord a => a -> a -> Bool
< a
36) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"bad address length "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
addressLen
forall a. [a] -> [a] -> [a]
++ [Char]
" for IPv6"
let nskip :: a
nskip = a
addressLen forall a. Num a => a -> a -> a
- a
36
Word32
s1 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
s2 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
s3 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
s4 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
d1 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
d2 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
d3 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word32
d4 <- Word32 -> Word32
ntohl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word32
snarf32
Word16
sp <- Word16 -> Word16
ntohs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
snarf16
Word16
dp <- Word16 -> Word16
ntohs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Word16
snarf16
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString
take forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nskip
let sa :: SockAddr
sa = PortNumber -> Word32 -> HostAddress6 -> Word32 -> SockAddr
N.SockAddrInet6 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
sp) Word32
flow (Word32
s1, Word32
s2, Word32
s3, Word32
s4) Word32
scopeId
let sb :: SockAddr
sb = PortNumber -> Word32 -> HostAddress6 -> Word32 -> SockAddr
N.SockAddrInet6 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dp) Word32
flow (Word32
d1, Word32
d2, Word32
d3, Word32
d4) Word32
scopeId
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
makeProxyInfo SockAddr
sa SockAddr
sb (SockAddr -> Family
addrFamily SockAddr
sa) SocketType
socketType
#ifndef WINDOWS
handleUnix :: a -> SocketType -> Parser ProxyInfo
handleUnix a
addressLen SocketType
socketType = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
addressLen forall a. Ord a => a -> a -> Bool
< a
216) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"bad address length "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
addressLen
forall a. [a] -> [a] -> [a]
++ [Char]
" for unix"
ByteString
addr1 <- Int -> Parser ByteString
take Int
108
ByteString
addr2 <- Int -> Parser ByteString
take Int
108
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Int -> Parser ByteString
take forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
addressLen forall a. Num a => a -> a -> a
- a
216
let sa :: SockAddr
sa = [Char] -> SockAddr
N.SockAddrUnix (ByteString -> [Char]
toUnixPath ByteString
addr1)
let sb :: SockAddr
sb = [Char] -> SockAddr
N.SockAddrUnix (ByteString -> [Char]
toUnixPath ByteString
addr2)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SockAddr -> SockAddr -> Family -> SocketType -> ProxyInfo
makeProxyInfo SockAddr
sa SockAddr
sb (SockAddr -> Family
addrFamily SockAddr
sa) SocketType
socketType
toUnixPath :: ByteString -> [Char]
toUnixPath = ByteString -> [Char]
S.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (forall a. Eq a => a -> a -> Bool
==Char
'\x00')
#endif
foreign import ccall unsafe "iostreams_ntohs" c_ntohs :: CUShort -> CUShort
foreign import ccall unsafe "iostreams_ntohl" c_ntohl :: CUInt -> CUInt
ntohs :: Word16 -> Word16
ntohs :: Word16 -> Word16
ntohs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> CUShort
c_ntohs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
ntohl :: Word32 -> Word32
ntohl :: Word32 -> Word32
ntohl = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> CUInt
c_ntohl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
snarf32 :: Parser Word32
snarf32 :: Parser Word32
snarf32 = do
ByteString
s <- Int -> Parser ByteString
take Int
4
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$! forall a. ByteString -> (CString -> IO a) -> IO a
S.unsafeUseAsCString ByteString
s forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr
snarf16 :: Parser Word16
snarf16 :: Parser ByteString Word16
snarf16 = do
ByteString
s <- Int -> Parser ByteString
take Int
2
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$! forall a. ByteString -> (CString -> IO a) -> IO a
S.unsafeUseAsCString ByteString
s forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Ptr a -> Ptr b
castPtr
addrFamily :: N.SockAddr -> N.Family
addrFamily :: SockAddr -> Family
addrFamily SockAddr
s = case SockAddr
s of
(N.SockAddrInet PortNumber
_ Word32
_) -> Family
N.AF_INET
(N.SockAddrInet6 PortNumber
_ Word32
_ HostAddress6
_ Word32
_) -> Family
N.AF_INET6
#ifndef WINDOWS
(N.SockAddrUnix [Char]
_ ) -> Family
N.AF_UNIX
#endif
SockAddr
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"unknown family"