diff options
author | Joey Hess <joey@kitenet.net> | 2014-02-25 16:09:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-02-25 16:16:14 -0400 |
commit | 67b52a441b98f4699688fe21e49178794a6feeeb (patch) | |
tree | fa96edee0803439ef575454bfff201f75f3888fa /Remote | |
parent | f6e6671641585fcdf37201df9914842b09392089 (diff) |
more DAV url fixes for windows
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/WebDAV.hs | 24 | ||||
-rw-r--r-- | Remote/WebDAV/DavUrl.hs | 44 |
2 files changed, 46 insertions, 22 deletions
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 737b98fa7..2cfe2f6d2 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -14,7 +14,6 @@ import qualified Data.Map as M import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.Lazy.UTF8 as L8 import qualified Data.ByteString.Lazy as L -import Network.URI (normalizePathSegments) import qualified Control.Exception as E import qualified Control.Exception.Lifted as EL #if MIN_VERSION_DAV(0,6,0) @@ -25,9 +24,8 @@ import Network.HTTP.Conduit (HttpException(..)) import Network.HTTP.Types import System.Log.Logger (debugM) import System.IO.Error -import System.FilePath.Posix ((</>), addTrailingPathSeparator) -import Common.Annex hiding ((</>), addTrailingPathSeparator) +import Common.Annex import Types.Remote import qualified Git import Config @@ -40,8 +38,8 @@ import Creds import Utility.Metered import Annex.Content import Annex.UUID +import Remote.WebDAV.DavUrl -type DavUrl = String type DavUser = B8.ByteString type DavPass = B8.ByteString @@ -237,19 +235,6 @@ toDavUser = B8.fromString toDavPass :: String -> DavPass toDavPass = B8.fromString -{- The directory where files(s) for a key are stored. -} -davLocation :: DavUrl -> Key -> DavUrl -davLocation baseurl k = addTrailingPathSeparator $ - davUrl baseurl $ hashDirLower k </> keyFile k - -{- Where we store temporary data for a key as it's being uploaded. -} -tmpLocation :: DavUrl -> Key -> DavUrl -tmpLocation baseurl k = addTrailingPathSeparator $ - davUrl baseurl $ "tmp" </> keyFile k - -davUrl :: DavUrl -> FilePath -> DavUrl -davUrl baseurl file = baseurl </> file - {- Creates a directory in WebDAV, if not already present; also creating - any missing parent directories. -} mkdirRecursiveDAV :: DavUrl -> DavUser -> DavPass -> IO () @@ -272,11 +257,6 @@ mkdirRecursiveDAV url user pass = go url - to use this directory will fail. -} Left _ -> return () -urlParent :: DavUrl -> DavUrl -urlParent url = dropTrailingPathSeparator $ - normalizePathSegments (dropTrailingPathSeparator url ++ "/..") - where - {- Test if a WebDAV store is usable, by writing to a test file, and then - deleting the file. Exits with an IO error if not. -} testDav :: String -> Maybe CredPair -> Annex () diff --git a/Remote/WebDAV/DavUrl.hs b/Remote/WebDAV/DavUrl.hs new file mode 100644 index 000000000..4862c4f37 --- /dev/null +++ b/Remote/WebDAV/DavUrl.hs @@ -0,0 +1,44 @@ +{- WebDAV urls. + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Remote.WebDAV.DavUrl where + +import Types +import Locations + +import Network.URI (normalizePathSegments) +import System.FilePath.Posix +#ifdef mingw32_HOST_OS +import Data.String.Utils +#endif + +type DavUrl = String + +{- The directory where files(s) for a key are stored. -} +davLocation :: DavUrl -> Key -> DavUrl +davLocation baseurl k = addTrailingPathSeparator $ + davUrl baseurl $ hashdir </> keyFile k + where +#ifndef mingw32_HOST_OS + hashdir = hashDirLower k +#else + hashdir = replace "\\" "/" (hashDirLower k) +#endif + +{- Where we store temporary data for a key as it's being uploaded. -} +tmpLocation :: DavUrl -> Key -> DavUrl +tmpLocation baseurl k = addTrailingPathSeparator $ + davUrl baseurl $ "tmp" </> keyFile k + +davUrl :: DavUrl -> FilePath -> DavUrl +davUrl baseurl file = baseurl </> file + +urlParent :: DavUrl -> DavUrl +urlParent url = dropTrailingPathSeparator $ + normalizePathSegments (dropTrailingPathSeparator url ++ "/..") |