From 014a3fef348650fad5abad53a131b2a4c56d20b3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 16 Jun 2018 18:44:27 -0400
Subject: [PATCH] added isPrivateAddress and isLoopbackAddress

For use in a security boundary enforcement.

Based on https://en.wikipedia.org/wiki/Reserved_IP_addresses

Including supporting IPv4 addresses embedded in IPv6 addresses. Because
while RFC6052 3.1 says "Address translators MUST NOT translate packets
in which an address is composed of the Well-Known Prefix and a non-
global IPv4 address; they MUST drop these packets", I don't want to
trust that implementations get that right when enforcing a security
boundary.

This commit was sponsored by John Pellman on Patreon.
---
 Utility/IPAddress.hs | 71 ++++++++++++++++++++++++++++++++++++++++++++
 git-annex.cabal      |  1 +
 2 files changed, 72 insertions(+)
 create mode 100644 Utility/IPAddress.hs

diff --git a/Utility/IPAddress.hs b/Utility/IPAddress.hs
new file mode 100644
index 0000000000..d868639fdd
--- /dev/null
+++ b/Utility/IPAddress.hs
@@ -0,0 +1,71 @@
+{- IP addresses
+ -
+ - Copyright 2012 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+module Utility.IPAddress where
+
+import Utility.Exception
+
+import Network.Socket
+import Data.Word
+import Control.Applicative
+import Prelude
+
+{- Check if an IP address is a loopback address; connecting to it
+ - may connect back to the local host. -}
+isLoopbackAddress :: SockAddr -> Bool
+isLoopbackAddress (SockAddrInet _ ipv4) = case hostAddressToTuple ipv4 of
+	-- localhost
+	(127,_,_,_) -> True
+	-- current network; functions equivilant to loopback
+	(0,_,_, _) -> True
+	_ -> False
+isLoopbackAddress (SockAddrInet6 _ _ ipv6 _) = case hostAddress6ToTuple ipv6 of
+	-- localhost
+	(0,0,0,0,0,0,0,1) -> True
+	-- unspecified address; functions equivilant to loopback
+	(0,0,0,0,0,0,0,0) -> True
+	v -> maybe False
+		(isLoopbackAddress . SockAddrInet 0)
+		(embeddedIpv4 v)
+isLoopbackAddress _ = False
+
+{- Check if an IP address is not globally routed, and is used
+ - for private communication, eg on a LAN. -}
+isPrivateAddress :: SockAddr -> Bool
+isPrivateAddress (SockAddrInet _ ipv4) = case hostAddressToTuple ipv4 of
+	-- lan
+	(10,_,_,_) -> True
+	(172,n,_,_) | n >= 16 && n <= 31 -> True -- 172.16.0.0/12
+	(192,168,_,_) -> True
+	-- carrier-grade NAT
+	(100,n,0,0) | n >= 64 && n <= 127 -> True -- 100.64.0.0/10
+	-- link-local
+	(169,254,_,_) -> True
+	_ -> False
+isPrivateAddress (SockAddrInet6 _ _ ipv6 _) = case hostAddress6ToTuple ipv6 of
+	v@(n,_,_,_,_,_,_,_)
+		-- local to lan or private between orgs
+		| n >= 0xfc00 && n <= 0xfdff -> True -- fc00::/7
+		-- link-local
+		| n >= 0xfe80 && n <= 0xfebf -> True --  fe80::/10
+		| otherwise -> maybe False
+			(isPrivateAddress . SockAddrInet 0)
+			(embeddedIpv4 v)
+isPrivateAddress _ = False
+
+embeddedIpv4 :: (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16) -> Maybe HostAddress
+embeddedIpv4 v = case v of
+	-- IPv4 mapped address (::ffff:0:0/96)
+	(0,0,0,0,0,0xffff,a,b) -> Just (toipv4 a b)
+	-- IPV4 translated address (::ffff:0:ipv4)
+	(0,0,0,0,0xffff,0,a,b) -> Just (toipv4 a b)
+	-- IPV4/IPV6 translation (64:ff9b::ipv4)
+	(0x64,0xff9b,0,0,0,0,a,b) -> Just (toipv4 a b)
+	_ -> Nothing
+  where
+	toipv4 a b = htonl $ fromIntegral a * (2^halfipv4bits) + fromIntegral b
+	halfipv4bits = 16 :: Word32
diff --git a/git-annex.cabal b/git-annex.cabal
index 9d12694ea1..bab975c26a 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1038,6 +1038,7 @@ Executable git-annex
     Utility.HumanNumber
     Utility.HumanTime
     Utility.InodeCache
+    Utility.IPAddress
     Utility.LinuxMkLibs
     Utility.LockFile
     Utility.LockFile.LockStatus