more DAV url fixes for windows
This commit is contained in:
parent
b1931d1cc1
commit
2aeb0750f9
2 changed files with 46 additions and 22 deletions
|
@ -14,7 +14,6 @@ import qualified Data.Map as M
|
||||||
import qualified Data.ByteString.UTF8 as B8
|
import qualified Data.ByteString.UTF8 as B8
|
||||||
import qualified Data.ByteString.Lazy.UTF8 as L8
|
import qualified Data.ByteString.Lazy.UTF8 as L8
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import Network.URI (normalizePathSegments)
|
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
import qualified Control.Exception.Lifted as EL
|
import qualified Control.Exception.Lifted as EL
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
|
@ -25,9 +24,8 @@ import Network.HTTP.Conduit (HttpException(..))
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
import System.Log.Logger (debugM)
|
import System.Log.Logger (debugM)
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.FilePath.Posix ((</>), addTrailingPathSeparator)
|
|
||||||
|
|
||||||
import Common.Annex hiding ((</>), addTrailingPathSeparator)
|
import Common.Annex
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Config
|
import Config
|
||||||
|
@ -40,8 +38,8 @@ import Creds
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
|
import Remote.WebDAV.DavUrl
|
||||||
|
|
||||||
type DavUrl = String
|
|
||||||
type DavUser = B8.ByteString
|
type DavUser = B8.ByteString
|
||||||
type DavPass = B8.ByteString
|
type DavPass = B8.ByteString
|
||||||
|
|
||||||
|
@ -237,19 +235,6 @@ toDavUser = B8.fromString
|
||||||
toDavPass :: String -> DavPass
|
toDavPass :: String -> DavPass
|
||||||
toDavPass = B8.fromString
|
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
|
{- Creates a directory in WebDAV, if not already present; also creating
|
||||||
- any missing parent directories. -}
|
- any missing parent directories. -}
|
||||||
mkdirRecursiveDAV :: DavUrl -> DavUser -> DavPass -> IO ()
|
mkdirRecursiveDAV :: DavUrl -> DavUser -> DavPass -> IO ()
|
||||||
|
@ -272,11 +257,6 @@ mkdirRecursiveDAV url user pass = go url
|
||||||
- to use this directory will fail. -}
|
- to use this directory will fail. -}
|
||||||
Left _ -> return ()
|
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
|
{- 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. -}
|
- deleting the file. Exits with an IO error if not. -}
|
||||||
testDav :: String -> Maybe CredPair -> Annex ()
|
testDav :: String -> Maybe CredPair -> Annex ()
|
||||||
|
|
44
Remote/WebDAV/DavUrl.hs
Normal file
44
Remote/WebDAV/DavUrl.hs
Normal 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 ++ "/..")
|
Loading…
Add table
Add a link
Reference in a new issue