more DAV url fixes for windows

This commit is contained in:
Joey Hess 2014-02-25 16:09:50 -04:00
parent b1931d1cc1
commit 2aeb0750f9
2 changed files with 46 additions and 22 deletions

View file

@ -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 ()

44
Remote/WebDAV/DavUrl.hs Normal file
View file

@ -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 ++ "/..")