support using haskell-dns for SRV lookups
This library should be easier to install than ADNS, so I've made it be used by default.
This commit is contained in:
Joey Hess
parent
64e1d7b579
commit
9173c66e40
4 changed files with 44 additions and 16 deletions
4
Makefile
4
Makefile
|
|
@ -6,7 +6,7 @@ BASEFLAGS=-Wall -outputdir $(GIT_ANNEX_TMP_BUILD_DIR) -IUtility
|
|||
# you can turn off some of these features.
|
||||
#
|
||||
# If you're using an old version of yesod, enable -DWITH_OLD_YESOD
|
||||
FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP
|
||||
FEATURES?=$(GIT_ANNEX_LOCAL_FEATURES) -DWITH_ASSISTANT -DWITH_S3 -DWITH_WEBAPP -DWITH_PAIRING -DWITH_XMPP -DWITH_DNS
|
||||
|
||||
bins=git-annex
|
||||
mans=git-annex.1 git-annex-shell.1
|
||||
|
|
@ -142,7 +142,7 @@ sdist: clean $(mans)
|
|||
hackage: sdist
|
||||
@cabal upload dist/*.tar.gz
|
||||
|
||||
THIRDPARTY_BINS=git curl lsof xargs rsync uuid wget gpg host \
|
||||
THIRDPARTY_BINS=git curl lsof xargs rsync uuid wget gpg \
|
||||
sha1sum sha224sum sha256sum sha384sum sha512sum
|
||||
|
||||
LINUXSTANDALONE_DEST=$(GIT_ANNEX_TMP_BUILD_DIR)/git-annex.linux
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
{- SRV record lookup
|
||||
-
|
||||
- Uses either the ADNS Haskell library, or if it's not installed,
|
||||
- the host command.
|
||||
- Uses either the ADNS Haskell library, or the standalone Haskell DNS
|
||||
- package, or the host command.
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
|
|
@ -30,6 +30,12 @@ import Data.Maybe
|
|||
#ifdef WITH_ADNS
|
||||
import ADNS.Resolver
|
||||
import Data.Either
|
||||
#else
|
||||
#ifdef WITH_DNS
|
||||
import qualified Network.DNS.Lookup as DNS
|
||||
import Network.DNS.Resolver
|
||||
import qualified Data.ByteString.UTF8 as B8
|
||||
#endif
|
||||
#endif
|
||||
|
||||
newtype SRV = SRV String
|
||||
|
|
@ -37,6 +43,8 @@ newtype SRV = SRV String
|
|||
|
||||
type HostPort = (HostName, PortID)
|
||||
|
||||
type PriorityWeight = (Int, Int) -- sort by priority first, then weight
|
||||
|
||||
mkSRV :: String -> String -> HostName -> SRV
|
||||
mkSRV transport protocol host = SRV $ concat
|
||||
["_", protocol, "._", transport, ".", host]
|
||||
|
|
@ -49,13 +57,27 @@ mkSRVTcp = mkSRV "tcp"
|
|||
- On error, returns an empty list. -}
|
||||
lookupSRV :: SRV -> IO [HostPort]
|
||||
#ifdef WITH_ADNS
|
||||
lookupSRV srv = initResolver [] $ \resolver -> do
|
||||
lookupSRV (SRV srv) = initResolver [] $ \resolver -> do
|
||||
r <- catchDefaultIO (Right []) $
|
||||
resolveSRV resolver srv
|
||||
return $ either (\_ -> []) id r
|
||||
#else
|
||||
#ifdef WITH_DNS
|
||||
lookupSRV (SRV srv) = do
|
||||
seed <- makeResolvSeed defaultResolvConf
|
||||
print srv
|
||||
r <- withResolver seed $ flip DNS.lookupSRV $ B8.fromString srv
|
||||
print r
|
||||
return $ maybe [] (orderHosts . map tohosts) r
|
||||
where
|
||||
tohosts (priority, weight, port, hostname) =
|
||||
( (priority, weight)
|
||||
, (B8.toString hostname, PortNumber $ fromIntegral port)
|
||||
)
|
||||
#else
|
||||
lookupSRV = lookupSRVHost
|
||||
#endif
|
||||
#endif
|
||||
|
||||
lookupSRVHost :: SRV -> IO [HostPort]
|
||||
lookupSRVHost (SRV srv)
|
||||
|
|
@ -66,17 +88,22 @@ lookupSRVHost (SRV srv)
|
|||
| otherwise = return []
|
||||
|
||||
parseSrvHost :: String -> [HostPort]
|
||||
parseSrvHost = map snd . reverse . sortBy cost . catMaybes . map parse . lines
|
||||
parseSrvHost = orderHosts . catMaybes . map parse . lines
|
||||
where
|
||||
cost = compare `on` fst
|
||||
parse l = case words l of
|
||||
[_, _, _, _, priority, weight, sport, hostname] -> do
|
||||
let v = readish sport :: Maybe Int
|
||||
[_, _, _, _, spriority, sweight, sport, hostname] -> do
|
||||
let v =
|
||||
( readish sport :: Maybe Int
|
||||
, readish spriority :: Maybe Int
|
||||
, readish sweight :: Maybe Int
|
||||
)
|
||||
case v of
|
||||
Nothing -> Nothing
|
||||
Just port -> Just
|
||||
(Just port, Just priority, Just weight) -> Just
|
||||
( (priority, weight)
|
||||
, (hostname, PortNumber $ fromIntegral port)
|
||||
)
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
|
||||
orderHosts :: [(PriorityWeight, HostPort)] -> [HostPort]
|
||||
orderHosts = map snd . sortBy (compare `on` fst)
|
||||
|
|
|
|||
|
|
@ -43,6 +43,7 @@ quite a lot.
|
|||
* [network-multicast](http://hackage.haskell.org/package/network-multicast)
|
||||
* [network-info](http://hackage.haskell.org/package/network-info)
|
||||
* [network-protocol-xmpp](http://hackage.haskell.org/package/network-protocol-xmpp)
|
||||
* [dns](http://hackage.haskell.org/package/dns)
|
||||
* Shell commands
|
||||
* [git](http://git-scm.com/)
|
||||
* [uuid](http://www.ossp.org/pkg/lib/uuid/)
|
||||
|
|
|
|||
|
|
@ -46,8 +46,8 @@ Flag Pairing
|
|||
Flag XMPP
|
||||
Description: Enable notifications using XMPP
|
||||
|
||||
Flag Adns
|
||||
Description: Enable the ADNS library for DNS lookup
|
||||
Flag DNS
|
||||
Description: Enable the haskell DNS library for DNS lookup
|
||||
|
||||
Executable git-annex
|
||||
Main-Is: git-annex.hs
|
||||
|
|
@ -101,9 +101,9 @@ Executable git-annex
|
|||
Build-Depends: network-protocol-xmpp, gnutls (>= 0.1.4)
|
||||
CPP-Options: -DWITH_XMPP
|
||||
|
||||
if flag(XMPP) && flag(Assistant) && flag(Adns)
|
||||
Build-Depends: hsdns
|
||||
CPP-Options: -DWITH_ADNS
|
||||
if flag(XMPP) && flag(Assistant) && flag(DNS)
|
||||
Build-Depends: dns
|
||||
CPP-Options: -DWITH_DNS
|
||||
|
||||
Test-Suite test
|
||||
Type: exitcode-stdio-1.0
|
||||
|
|
|
|||
Loading…
Reference in a new issue