summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-25 16:09:50 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-25 16:16:14 -0400
commit67b52a441b98f4699688fe21e49178794a6feeeb (patch)
treefa96edee0803439ef575454bfff201f75f3888fa /Remote
parentf6e6671641585fcdf37201df9914842b09392089 (diff)
more DAV url fixes for windows
Diffstat (limited to 'Remote')
-rw-r--r--Remote/WebDAV.hs24
-rw-r--r--Remote/WebDAV/DavUrl.hs44
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 ++ "/..")