diff --git a/COPYRIGHT b/COPYRIGHT index cf08323b96..2b19d183b9 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -24,6 +24,11 @@ Copyright: 2011 Bas van Dijk & Roel van Dijk 2012, 2013 Joey Hess License: BSD-2-clause +Files: Utility/HttpManagerRestricted.hs +Copyright: 2018 Joey Hess + 2013 Michael Snoyman +License: MIT + Files: Utility/* Copyright: 2012-2018 Joey Hess License: BSD-2-clause @@ -51,26 +56,7 @@ Copyright: © 2005-2011 by John Resig, Branden Aaron & Jörn Zaefferer License: MIT or GPL-2 The full text of version 2 of the GPL is distributed in /usr/share/common-licenses/GPL-2 on Debian systems. The text of the MIT - license follows: - . - Permission is hereby granted, free of charge, to any person obtaining - a copy of this software and associated documentation files (the - "Software"), to deal in the Software without restriction, including - without limitation the rights to use, copy, modify, merge, publish, - distribute, sublicense, and/or sell copies of the Software, and to - permit persons to whom the Software is furnished to do so, subject to - the following conditions: - . - The above copyright notice and this permission notice shall be - included in all copies or substantial portions of the Software. - . - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, - EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF - MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND - NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE - LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION - OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION - WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + license is in the MIT section below. Files: static/*/bootstrap* static/*/glyphicons-halflings* Copyright: 2012-2014 Twitter, Inc. @@ -153,6 +139,26 @@ License: BSD-2-clause 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. + +License: MIT + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + "Software"), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + . + The above copyright notice and this permission notice shall be + included in all copies or substantial portions of the Software. + . + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE + LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION + OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. License: AGPL-3+ GNU AFFERO GENERAL PUBLIC LICENSE diff --git a/Utility/HttpManagerRestricted.hs b/Utility/HttpManagerRestricted.hs new file mode 100644 index 0000000000..2b1e241cc4 --- /dev/null +++ b/Utility/HttpManagerRestricted.hs @@ -0,0 +1,132 @@ +{- | Restricted Manager for http-client-tls + - + - Copyright 2018 Joey Hess + - + - Portions from http-client-tls Copyright (c) 2013 Michael Snoyman + - + - License: MIT + -} + +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} + +module Utility.HttpManagerRestricted ( + restrictManagerSettings, + Restriction(..), + ConnectionRestricted(..), + addrConnectionRestricted, +) where + +import Network.HTTP.Client +import Network.HTTP.Client.Internal (ManagerSettings(..), Connection) +import Network.HTTP.Client.TLS +import Network.Socket +import Network.BSD (getProtocolNumber) +import Control.Exception +import qualified Network.Connection as NC +import Data.ByteString (ByteString) +import Data.Default +import Data.Typeable + +data Restriction = Restriction + { addressRestriction :: AddrInfo -> Maybe ConnectionRestricted + } + +data ConnectionRestricted = ConnectionRestricted String + deriving (Show, Typeable) + +instance Exception ConnectionRestricted + +addrConnectionRestricted :: AddrInfo -> ConnectionRestricted +addrConnectionRestricted addr = ConnectionRestricted $ unwords + [ "Configuration does not allow accessing address" + , case addrAddress addr of + a@(SockAddrInet _ _) -> + takeWhile (/= ':') $ show a + a@(SockAddrInet6 _ _ _ _) -> + takeWhile (/= ']') $ drop 1 $ show a + ] + +-- | Adjusts a ManagerSettings to check a Restriction. +-- +-- Note that connections to http proxies are not checked. +-- Use `managerSetProxy noProxy` to prevent connections through http +-- proxies. +restrictManagerSettings :: Restriction -> ManagerSettings -> ManagerSettings +restrictManagerSettings cfg base = base + { managerRawConnection = restrictedRawConnection cfg + , managerTlsConnection = restrictedTlsConnection cfg + , managerWrapException = \req -> + let wrapper se + | Just (_ :: ConnectionRestricted) <- fromException se = + toException $ HttpExceptionRequest req $ + InternalException se + | otherwise = se + in handle $ throwIO . wrapper + } + +restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection) +restrictedRawConnection cfg = getConnection cfg Nothing + +restrictedTlsConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection) +restrictedTlsConnection cfg = getConnection cfg $ + -- It's not possible to access the TLSSettings + -- used in the base ManagerSettings. So, use the default + -- value, which is the same thing http-client-tls defaults to. + -- Since changing from the default settings can only make TLS + -- less secure, this is not a big problem. + Just def + +-- Based on Network.HTTP.Client.TLS.getTlsConnection. +-- +-- Checks the Restriction +-- +-- Does not support SOCKS. +getConnection :: Restriction -> Maybe NC.TLSSettings -> IO (Maybe HostAddress -> String -> Int -> IO Connection) +getConnection cfg tls = do + context <- NC.initConnectionContext + return $ \_ha host port -> bracketOnError + (go context host port) + NC.connectionClose + convertConnection + where + go context host port = do + let connparams = NC.ConnectionParams + { NC.connectionHostname = host + , NC.connectionPort = fromIntegral port + , NC.connectionUseSecure = tls + , NC.connectionUseSocks = Nothing -- unsupprted + } + proto <- getProtocolNumber "tcp" + let serv = show port + let hints = defaultHints + { addrFlags = [AI_ADDRCONFIG] + , addrProtocol = proto + , addrSocketType = Stream + } + addrs <- getAddrInfo (Just hints) (Just host) (Just serv) + bracketOnError + (firstSuccessful $ map tryToConnect addrs) + close + (\sock -> NC.connectFromSocket context sock connparams) + where + tryToConnect addr = case addressRestriction cfg addr of + Nothing -> bracketOnError + (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) + close + (\sock -> connect sock (addrAddress addr) >> return sock) + Just r -> throwIO r + firstSuccessful [] = throwIO $ NC.HostNotResolved host + firstSuccessful (a:as) = a `catch` \(e ::IOException) -> + case as of + [] -> throwIO e + _ -> firstSuccessful as + +-- Copied from Network.HTTP.Client.TLS, unfortunately not exported. +convertConnection :: NC.Connection -> IO Connection +convertConnection conn = makeConnection + (NC.connectionGetChunk conn) + (NC.connectionPut conn) + -- Closing an SSL connection gracefully involves writing/reading + -- on the socket. But when this is called the socket might be + -- already closed, and we get a @ResourceVanished@. + (NC.connectionClose conn `Control.Exception.catch` \(_ :: IOException) -> return ()) diff --git a/git-annex.cabal b/git-annex.cabal index 627e760783..9d12694ea1 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -340,7 +340,9 @@ Executable git-annex bloomfilter, edit-distance, resourcet, + connection, http-client, + http-client-tls, http-types (>= 0.7), http-conduit (>= 2.0), conduit, @@ -1032,6 +1034,7 @@ Executable git-annex Utility.Gpg Utility.Hash Utility.HtmlDetect + Utility.HttpManagerRestricted Utility.HumanNumber Utility.HumanTime Utility.InodeCache