Merge branch 'master' of git://git-annex.branchable.com
This commit is contained in:
commit
71426bf41c
25 changed files with 178 additions and 85 deletions
19
Assistant.hs
19
Assistant.hs
|
@ -49,11 +49,13 @@ import Assistant.Threads.XMPPPusher
|
||||||
import Assistant.Types.UrlRenderer
|
import Assistant.Types.UrlRenderer
|
||||||
#endif
|
#endif
|
||||||
import qualified Utility.Daemon
|
import qualified Utility.Daemon
|
||||||
import Utility.LogFile
|
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
import Utility.HumanTime
|
import Utility.HumanTime
|
||||||
import Annex.Perms
|
|
||||||
import qualified Build.SysConfig as SysConfig
|
import qualified Build.SysConfig as SysConfig
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
|
import Utility.LogFile
|
||||||
|
import Annex.Perms
|
||||||
|
#endif
|
||||||
|
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
import Network.Socket (HostName)
|
import Network.Socket (HostName)
|
||||||
|
@ -70,8 +72,8 @@ startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName
|
||||||
startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do
|
startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do
|
||||||
Annex.changeState $ \s -> s { Annex.daemon = True }
|
Annex.changeState $ \s -> s { Annex.daemon = True }
|
||||||
pidfile <- fromRepo gitAnnexPidFile
|
pidfile <- fromRepo gitAnnexPidFile
|
||||||
logfile <- fromRepo gitAnnexLogFile
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
|
logfile <- fromRepo gitAnnexLogFile
|
||||||
createAnnexDirectory (parentDir logfile)
|
createAnnexDirectory (parentDir logfile)
|
||||||
logfd <- liftIO $ openLog logfile
|
logfd <- liftIO $ openLog logfile
|
||||||
if foreground
|
if foreground
|
||||||
|
@ -93,11 +95,12 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
|
||||||
start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
|
start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
|
||||||
#else
|
#else
|
||||||
-- Windows is always foreground, and has no log file.
|
-- Windows is always foreground, and has no log file.
|
||||||
liftIO $ Utility.Daemon.lockPidFile pidfile
|
when (foreground || not foreground) $ do
|
||||||
start id $ do
|
liftIO $ Utility.Daemon.lockPidFile pidfile
|
||||||
case startbrowser of
|
start id $ do
|
||||||
Nothing -> Nothing
|
case startbrowser of
|
||||||
Just a -> Just $ a Nothing Nothing
|
Nothing -> Nothing
|
||||||
|
Just a -> Just $ a Nothing Nothing
|
||||||
#endif
|
#endif
|
||||||
where
|
where
|
||||||
desc
|
desc
|
||||||
|
|
|
@ -24,8 +24,10 @@ import DBus
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
import Assistant.NetMessager
|
import Assistant.NetMessager
|
||||||
#else
|
#else
|
||||||
|
#ifdef linux_HOST_OS
|
||||||
#warning Building without dbus support; will poll for network connection changes
|
#warning Building without dbus support; will poll for network connection changes
|
||||||
#endif
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
netWatcherThread :: NamedThread
|
netWatcherThread :: NamedThread
|
||||||
#if WITH_DBUS
|
#if WITH_DBUS
|
||||||
|
|
|
@ -27,7 +27,6 @@ import qualified Git.Command
|
||||||
import qualified Git.Config
|
import qualified Git.Config
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
import qualified Assistant.Threads.Watcher as Watcher
|
import qualified Assistant.Threads.Watcher as Watcher
|
||||||
import Utility.LogFile
|
|
||||||
import Utility.Batch
|
import Utility.Batch
|
||||||
import Utility.NotificationBroadcaster
|
import Utility.NotificationBroadcaster
|
||||||
import Config
|
import Config
|
||||||
|
@ -43,6 +42,9 @@ import qualified Annex
|
||||||
#ifdef WITH_WEBAPP
|
#ifdef WITH_WEBAPP
|
||||||
import Assistant.WebApp.Types
|
import Assistant.WebApp.Types
|
||||||
#endif
|
#endif
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
|
import Utility.LogFile
|
||||||
|
#endif
|
||||||
|
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -214,10 +216,10 @@ checkLogSize n = do
|
||||||
checkLogSize $ n + 1
|
checkLogSize $ n + 1
|
||||||
where
|
where
|
||||||
filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)
|
filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)
|
||||||
#endif
|
|
||||||
|
|
||||||
oneMegabyte :: Int
|
oneMegabyte :: Int
|
||||||
oneMegabyte = 1000000
|
oneMegabyte = 1000000
|
||||||
|
#endif
|
||||||
|
|
||||||
oneHour :: Int
|
oneHour :: Int
|
||||||
oneHour = 60 * 60
|
oneHour = 60 * 60
|
||||||
|
|
|
@ -23,7 +23,6 @@ import Assistant.Types.Changes
|
||||||
import Assistant.Alert
|
import Assistant.Alert
|
||||||
import Utility.DirWatcher
|
import Utility.DirWatcher
|
||||||
import Utility.DirWatcher.Types
|
import Utility.DirWatcher.Types
|
||||||
import qualified Utility.Lsof as Lsof
|
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Annex.Queue
|
import qualified Annex.Queue
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
@ -40,6 +39,9 @@ import Annex.ReplaceFile
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import Config
|
import Config
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
|
import qualified Utility.Lsof as Lsof
|
||||||
|
#endif
|
||||||
|
|
||||||
import Data.Bits.Utils
|
import Data.Bits.Utils
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
|
|
|
@ -114,9 +114,9 @@ checkRepositoryPath p = do
|
||||||
- browsed to a directory with git-annex and run it from there. -}
|
- browsed to a directory with git-annex and run it from there. -}
|
||||||
defaultRepositoryPath :: Bool -> IO FilePath
|
defaultRepositoryPath :: Bool -> IO FilePath
|
||||||
defaultRepositoryPath firstrun = do
|
defaultRepositoryPath firstrun = do
|
||||||
cwd <- liftIO getCurrentDirectory
|
|
||||||
home <- myHomeDir
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
|
home <- myHomeDir
|
||||||
|
cwd <- liftIO getCurrentDirectory
|
||||||
if home == cwd && firstrun
|
if home == cwd && firstrun
|
||||||
then inhome
|
then inhome
|
||||||
else ifM (legit cwd <&&> canWrite cwd)
|
else ifM (legit cwd <&&> canWrite cwd)
|
||||||
|
@ -127,7 +127,7 @@ defaultRepositoryPath firstrun = do
|
||||||
-- On Windows, always default to ~/Desktop/annex or ~/annex,
|
-- On Windows, always default to ~/Desktop/annex or ~/annex,
|
||||||
-- no cwd handling because the user might be able to write
|
-- no cwd handling because the user might be able to write
|
||||||
-- to the entire drive.
|
-- to the entire drive.
|
||||||
inhome
|
if firstrun then inhome else inhome
|
||||||
#endif
|
#endif
|
||||||
where
|
where
|
||||||
inhome = do
|
inhome = do
|
||||||
|
@ -136,9 +136,11 @@ defaultRepositoryPath firstrun = do
|
||||||
( relHome $ desktop </> gitAnnexAssistantDefaultDir
|
( relHome $ desktop </> gitAnnexAssistantDefaultDir
|
||||||
, return $ "~" </> gitAnnexAssistantDefaultDir
|
, return $ "~" </> gitAnnexAssistantDefaultDir
|
||||||
)
|
)
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
-- Avoid using eg, standalone build's git-annex.linux/ directory
|
-- Avoid using eg, standalone build's git-annex.linux/ directory
|
||||||
-- when run from there.
|
-- when run from there.
|
||||||
legit d = not <$> doesFileExist (d </> "git-annex")
|
legit d = not <$> doesFileExist (d </> "git-annex")
|
||||||
|
#endif
|
||||||
|
|
||||||
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
|
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
|
||||||
newRepositoryForm defpath msg = do
|
newRepositoryForm defpath msg = do
|
||||||
|
|
|
@ -12,7 +12,6 @@ module Assistant.WebApp.Configurators.Pairing where
|
||||||
|
|
||||||
import Assistant.Pairing
|
import Assistant.Pairing
|
||||||
import Assistant.WebApp.Common
|
import Assistant.WebApp.Common
|
||||||
import Assistant.WebApp.Configurators
|
|
||||||
import Assistant.Types.Buddies
|
import Assistant.Types.Buddies
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
#ifdef WITH_PAIRING
|
#ifdef WITH_PAIRING
|
||||||
|
@ -32,6 +31,7 @@ import Network.Protocol.XMPP
|
||||||
import Assistant.Types.NetMessager
|
import Assistant.Types.NetMessager
|
||||||
import Assistant.NetMessager
|
import Assistant.NetMessager
|
||||||
import Assistant.WebApp.RepoList
|
import Assistant.WebApp.RepoList
|
||||||
|
import Assistant.WebApp.Configurators
|
||||||
import Assistant.WebApp.Configurators.XMPP
|
import Assistant.WebApp.Configurators.XMPP
|
||||||
#endif
|
#endif
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
|
|
|
@ -218,15 +218,15 @@ link file key mcache = flip catchAnnex (undo file key) $ do
|
||||||
l <- inRepo $ gitAnnexLink file key
|
l <- inRepo $ gitAnnexLink file key
|
||||||
replaceFile file $ makeAnnexLink l
|
replaceFile file $ makeAnnexLink l
|
||||||
|
|
||||||
#ifdef WITH_CLIBS
|
|
||||||
#ifndef __ANDROID__
|
|
||||||
-- touch symlink to have same time as the original file,
|
-- touch symlink to have same time as the original file,
|
||||||
-- as provided in the InodeCache
|
-- as provided in the InodeCache
|
||||||
case mcache of
|
case mcache of
|
||||||
|
#if defined(WITH_CLIBS) && ! defined(__ANDROID__)
|
||||||
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
|
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
|
||||||
|
#else
|
||||||
|
Just _ -> noop
|
||||||
|
#endif
|
||||||
Nothing -> noop
|
Nothing -> noop
|
||||||
#endif
|
|
||||||
#endif
|
|
||||||
|
|
||||||
return l
|
return l
|
||||||
|
|
||||||
|
|
|
@ -466,7 +466,8 @@ getFsckTime key = do
|
||||||
- To guard against time stamp damange (for example, if an annex directory
|
- To guard against time stamp damange (for example, if an annex directory
|
||||||
- is copied without -a), the fsckstate file contains a time that should
|
- is copied without -a), the fsckstate file contains a time that should
|
||||||
- be identical to its modification time.
|
- be identical to its modification time.
|
||||||
- (This is not possible to do on Windows.)
|
- (This is not possible to do on Windows, and so the timestamp in
|
||||||
|
- the file will only be equal or greater than the modification time.)
|
||||||
-}
|
-}
|
||||||
recordStartTime :: Annex ()
|
recordStartTime :: Annex ()
|
||||||
recordStartTime = do
|
recordStartTime = do
|
||||||
|
@ -477,10 +478,10 @@ recordStartTime = do
|
||||||
withFile f WriteMode $ \h -> do
|
withFile f WriteMode $ \h -> do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
t <- modificationTime <$> getFileStatus f
|
t <- modificationTime <$> getFileStatus f
|
||||||
hPutStr h $ showTime $ realToFrac t
|
|
||||||
#else
|
#else
|
||||||
noop
|
t <- getPOSIXTime
|
||||||
#endif
|
#endif
|
||||||
|
hPutStr h $ showTime $ realToFrac t
|
||||||
where
|
where
|
||||||
showTime :: POSIXTime -> String
|
showTime :: POSIXTime -> String
|
||||||
showTime = show
|
showTime = show
|
||||||
|
@ -494,15 +495,18 @@ getStartTime = do
|
||||||
f <- fromRepo gitAnnexFsckState
|
f <- fromRepo gitAnnexFsckState
|
||||||
liftIO $ catchDefaultIO Nothing $ do
|
liftIO $ catchDefaultIO Nothing $ do
|
||||||
timestamp <- modificationTime <$> getFileStatus f
|
timestamp <- modificationTime <$> getFileStatus f
|
||||||
#ifndef mingw32_HOST_OS
|
let fromstatus = Just (realToFrac timestamp)
|
||||||
t <- readishTime <$> readFile f
|
fromfile <- readishTime <$> readFile f
|
||||||
return $ if Just (realToFrac timestamp) == t
|
return $ if matchingtimestamp fromfile fromstatus
|
||||||
then Just timestamp
|
then Just timestamp
|
||||||
else Nothing
|
else Nothing
|
||||||
#else
|
|
||||||
return $ Just timestamp
|
|
||||||
#endif
|
|
||||||
where
|
where
|
||||||
readishTime :: String -> Maybe POSIXTime
|
readishTime :: String -> Maybe POSIXTime
|
||||||
readishTime s = utcTimeToPOSIXSeconds <$>
|
readishTime s = utcTimeToPOSIXSeconds <$>
|
||||||
parseTime defaultTimeLocale "%s%Qs" s
|
parseTime defaultTimeLocale "%s%Qs" s
|
||||||
|
matchingtimestamp fromfile fromstatus =
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
|
fromfile == fromstatus
|
||||||
|
#else
|
||||||
|
fromfile >= fromstatus
|
||||||
|
#endif
|
||||||
|
|
|
@ -15,9 +15,6 @@ import Common
|
||||||
import Git
|
import Git
|
||||||
import Git.Types
|
import Git.Types
|
||||||
import qualified Utility.CoProcess as CoProcess
|
import qualified Utility.CoProcess as CoProcess
|
||||||
#ifdef mingw32_HOST_OS
|
|
||||||
import Git.FilePath
|
|
||||||
#endif
|
|
||||||
import Utility.Batch
|
import Utility.Batch
|
||||||
|
|
||||||
{- Constructs a git command line operating on the specified repo. -}
|
{- Constructs a git command line operating on the specified repo. -}
|
||||||
|
|
13
Git/Queue.hs
13
Git/Queue.hs
|
@ -17,16 +17,17 @@ module Git.Queue (
|
||||||
flush,
|
flush,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import System.IO
|
|
||||||
import System.Process
|
|
||||||
|
|
||||||
import Utility.SafeCommand
|
import Utility.SafeCommand
|
||||||
import Common
|
import Common
|
||||||
import Git
|
import Git
|
||||||
import Git.Command
|
import Git.Command
|
||||||
import qualified Git.UpdateIndex
|
import qualified Git.UpdateIndex
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
|
import System.Process
|
||||||
|
#endif
|
||||||
|
|
||||||
{- Queable actions that can be performed in a git repository.
|
{- Queable actions that can be performed in a git repository.
|
||||||
-}
|
-}
|
||||||
data Action
|
data Action
|
||||||
|
@ -147,8 +148,9 @@ runAction :: Repo -> Action -> IO ()
|
||||||
runAction repo (UpdateIndexAction streamers) =
|
runAction repo (UpdateIndexAction streamers) =
|
||||||
-- list is stored in reverse order
|
-- list is stored in reverse order
|
||||||
Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers
|
Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers
|
||||||
runAction repo action@(CommandAction {}) =
|
runAction repo action@(CommandAction {}) = do
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
|
let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
|
||||||
withHandle StdinHandle createProcessSuccess p $ \h -> do
|
withHandle StdinHandle createProcessSuccess p $ \h -> do
|
||||||
fileEncoding h
|
fileEncoding h
|
||||||
hPutStr h $ intercalate "\0" $ toCommand $ getFiles action
|
hPutStr h $ intercalate "\0" $ toCommand $ getFiles action
|
||||||
|
@ -162,6 +164,5 @@ runAction repo action@(CommandAction {}) =
|
||||||
void $ boolSystem "git" (gitparams ++ [f])
|
void $ boolSystem "git" (gitparams ++ [f])
|
||||||
#endif
|
#endif
|
||||||
where
|
where
|
||||||
p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
|
|
||||||
gitparams = gitCommandLine
|
gitparams = gitCommandLine
|
||||||
(Param (getSubcommand action):getParams action) repo
|
(Param (getSubcommand action):getParams action) repo
|
||||||
|
|
|
@ -285,7 +285,7 @@ keyUrls r key = map tourl locs'
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
locs' = locs
|
locs' = locs
|
||||||
#else
|
#else
|
||||||
locs' = map (replace "\\" "/") (annexLocations key)
|
locs' = map (replace "\\" "/") locs
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
dropKey :: Remote -> Key -> Annex Bool
|
dropKey :: Remote -> Key -> Annex Bool
|
||||||
|
|
|
@ -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)
|
||||||
|
@ -23,6 +22,7 @@ import Network.HTTP.Client (HttpException(..))
|
||||||
import Network.HTTP.Conduit (HttpException(..))
|
import Network.HTTP.Conduit (HttpException(..))
|
||||||
#endif
|
#endif
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
|
import System.Log.Logger (debugM)
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
@ -38,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
|
||||||
|
|
||||||
|
@ -235,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 ()
|
||||||
|
@ -270,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 ()
|
||||||
|
@ -311,12 +293,16 @@ contentType = Just $ B8.fromString "application/octet-stream"
|
||||||
throwIO :: String -> IO a
|
throwIO :: String -> IO a
|
||||||
throwIO msg = ioError $ mkIOError userErrorType msg Nothing Nothing
|
throwIO msg = ioError $ mkIOError userErrorType msg Nothing Nothing
|
||||||
|
|
||||||
|
debugDAV :: DavUrl -> String -> IO ()
|
||||||
|
debugDAV msg url = debugM "DAV" $ msg ++ " " ++ url
|
||||||
|
|
||||||
{---------------------------------------------------------------------
|
{---------------------------------------------------------------------
|
||||||
- Low-level DAV operations, using the new DAV monad when available.
|
- Low-level DAV operations, using the new DAV monad when available.
|
||||||
---------------------------------------------------------------------}
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
putDAV :: DavUrl -> DavUser -> DavPass -> L.ByteString -> IO ()
|
putDAV :: DavUrl -> DavUser -> DavPass -> L.ByteString -> IO ()
|
||||||
putDAV url user pass b =
|
putDAV url user pass b = do
|
||||||
|
debugDAV "PUT" url
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
goDAV url user pass $ putContentM (contentType, b)
|
goDAV url user pass $ putContentM (contentType, b)
|
||||||
#else
|
#else
|
||||||
|
@ -324,7 +310,9 @@ putDAV url user pass b =
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
getDAV :: DavUrl -> DavUser -> DavPass -> IO (Maybe L.ByteString)
|
getDAV :: DavUrl -> DavUser -> DavPass -> IO (Maybe L.ByteString)
|
||||||
getDAV url user pass = eitherToMaybe <$> tryNonAsync go
|
getDAV url user pass = do
|
||||||
|
debugDAV "GET" url
|
||||||
|
eitherToMaybe <$> tryNonAsync go
|
||||||
where
|
where
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
go = goDAV url user pass $ snd <$> getContentM
|
go = goDAV url user pass $ snd <$> getContentM
|
||||||
|
@ -333,7 +321,8 @@ getDAV url user pass = eitherToMaybe <$> tryNonAsync go
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
deleteDAV :: DavUrl -> DavUser -> DavPass -> IO ()
|
deleteDAV :: DavUrl -> DavUser -> DavPass -> IO ()
|
||||||
deleteDAV url user pass =
|
deleteDAV url user pass = do
|
||||||
|
debugDAV "DELETE" url
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
goDAV url user pass delContentM
|
goDAV url user pass delContentM
|
||||||
#else
|
#else
|
||||||
|
@ -341,7 +330,8 @@ deleteDAV url user pass =
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
moveDAV :: DavUrl -> DavUrl -> DavUser -> DavPass -> IO ()
|
moveDAV :: DavUrl -> DavUrl -> DavUser -> DavPass -> IO ()
|
||||||
moveDAV url newurl user pass =
|
moveDAV url newurl user pass = do
|
||||||
|
debugDAV ("MOVE to " ++ newurl ++ " from ") url
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
goDAV url user pass $ moveContentM newurl'
|
goDAV url user pass $ moveContentM newurl'
|
||||||
#else
|
#else
|
||||||
|
@ -351,7 +341,8 @@ moveDAV url newurl user pass =
|
||||||
newurl' = B8.fromString newurl
|
newurl' = B8.fromString newurl
|
||||||
|
|
||||||
mkdirDAV :: DavUrl -> DavUser -> DavPass -> IO Bool
|
mkdirDAV :: DavUrl -> DavUser -> DavPass -> IO Bool
|
||||||
mkdirDAV url user pass =
|
mkdirDAV url user pass = do
|
||||||
|
debugDAV "MKDIR" url
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
goDAV url user pass mkCol
|
goDAV url user pass mkCol
|
||||||
#else
|
#else
|
||||||
|
@ -359,7 +350,9 @@ mkdirDAV url user pass =
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
|
existsDAV :: DavUrl -> DavUser -> DavPass -> IO (Either String Bool)
|
||||||
existsDAV url user pass = either (Left . show) id <$> tryNonAsync check
|
existsDAV url user pass = do
|
||||||
|
debugDAV "EXISTS" url
|
||||||
|
either (Left . show) id <$> tryNonAsync check
|
||||||
where
|
where
|
||||||
ispresent = return . Right
|
ispresent = return . Right
|
||||||
#if MIN_VERSION_DAV(0,6,0)
|
#if MIN_VERSION_DAV(0,6,0)
|
||||||
|
|
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 ++ "/..")
|
|
@ -11,7 +11,9 @@ module Utility.LogFile where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
|
||||||
|
#ifndef mingw32_HOST_OS
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
openLog :: FilePath -> IO Fd
|
openLog :: FilePath -> IO Fd
|
||||||
|
|
|
@ -18,7 +18,6 @@ import Data.Char
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
|
||||||
#ifdef mingw32_HOST_OS
|
#ifdef mingw32_HOST_OS
|
||||||
import Data.Char
|
|
||||||
import qualified System.FilePath.Posix as Posix
|
import qualified System.FilePath.Posix as Posix
|
||||||
#else
|
#else
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
|
|
|
@ -23,7 +23,6 @@ import Network.HTTP.Types
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Control.Exception
|
|
||||||
import "crypto-api" Crypto.Random
|
import "crypto-api" Crypto.Random
|
||||||
import qualified Web.ClientSession as CS
|
import qualified Web.ClientSession as CS
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
@ -39,6 +38,10 @@ import Control.Concurrent
|
||||||
#ifdef __ANDROID__
|
#ifdef __ANDROID__
|
||||||
import Data.Endian
|
import Data.Endian
|
||||||
#endif
|
#endif
|
||||||
|
#if defined(__ANDROID__) || defined (mingw32_HOST_OS)
|
||||||
|
#else
|
||||||
|
import Control.Exception (bracketOnError)
|
||||||
|
#endif
|
||||||
|
|
||||||
localhost :: HostName
|
localhost :: HostName
|
||||||
localhost = "localhost"
|
localhost = "localhost"
|
||||||
|
|
|
@ -11,9 +11,5 @@ module Utility.WinProcess where
|
||||||
|
|
||||||
import Utility.PID
|
import Utility.PID
|
||||||
|
|
||||||
import System.Win32.Process
|
|
||||||
import Foreign.C
|
|
||||||
import Control.Exception
|
|
||||||
|
|
||||||
foreign import ccall unsafe "terminatepid"
|
foreign import ccall unsafe "terminatepid"
|
||||||
terminatePID :: PID -> IO ()
|
terminatePID :: PID -> IO ()
|
||||||
|
|
15
debian/changelog
vendored
15
debian/changelog
vendored
|
@ -1,28 +1,29 @@
|
||||||
git-annex (5.20140222) UNRELEASED; urgency=medium
|
git-annex (5.20140222) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
* Fix handling of rsync remote urls containing a username,
|
* metadata: Field names limited to alphanumerics and a few whitelisted
|
||||||
including rsync.net.
|
punctuation characters to avoid issues with views, etc.
|
||||||
* --metadata field=value can now use globs to match, and matches
|
|
||||||
case insensatively, the same as git annex view field=value does.
|
|
||||||
* When constructing views, metadata is available about the location of the
|
* When constructing views, metadata is available about the location of the
|
||||||
file in the view's reference branch. Allows incorporating parts of the
|
file in the view's reference branch. Allows incorporating parts of the
|
||||||
directory hierarchy in a view.
|
directory hierarchy in a view.
|
||||||
For example `git annex view tag=* podcasts/=*` makes a view in the form
|
For example `git annex view tag=* podcasts/=*` makes a view in the form
|
||||||
tag/showname.
|
tag/showname.
|
||||||
|
* --metadata field=value can now use globs to match, and matches
|
||||||
|
case insensatively, the same as git annex view field=value does.
|
||||||
* annex.genmetadata can be set to make git-annex automatically set
|
* annex.genmetadata can be set to make git-annex automatically set
|
||||||
metadata (year and month) when adding files.
|
metadata (year and month) when adding files.
|
||||||
|
* Make annex.web-options be used in several places that call curl.
|
||||||
|
* Fix handling of rsync remote urls containing a username,
|
||||||
|
including rsync.net.
|
||||||
* Preserve metadata when staging a new version of an annexed file.
|
* Preserve metadata when staging a new version of an annexed file.
|
||||||
* metadata: Field names limited to alphanumerics and a few whitelisted
|
|
||||||
punctuation characters to avoid issues with views, etc.
|
|
||||||
* metadata: Support --json
|
* metadata: Support --json
|
||||||
* webapp: Fix creation of box.com and Amazon S3 and Glacier
|
* webapp: Fix creation of box.com and Amazon S3 and Glacier
|
||||||
repositories, broken in 5.20140221.
|
repositories, broken in 5.20140221.
|
||||||
* webdav: When built with DAV 0.6.0, use the new DAV monad to avoid
|
* webdav: When built with DAV 0.6.0, use the new DAV monad to avoid
|
||||||
locking files, which is not needed by git-annex's use of webdav, and
|
locking files, which is not needed by git-annex's use of webdav, and
|
||||||
does not work on Box.com.
|
does not work on Box.com.
|
||||||
|
* webdav: Fix path separator bug when used on Windows.
|
||||||
* repair: Optimise unpacking of pack files, and avoid repeated error
|
* repair: Optimise unpacking of pack files, and avoid repeated error
|
||||||
messages about corrupt pack files.
|
messages about corrupt pack files.
|
||||||
* Make annex.web-options be used in several places that call curl.
|
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Fri, 21 Feb 2014 13:03:04 -0400
|
-- Joey Hess <joeyh@debian.org> Fri, 21 Feb 2014 13:03:04 -0400
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
[[!comment format=txt
|
||||||
|
username="https://www.google.com/accounts/o8/id?id=AItOawnJTqmRu1YCKS2Hsm4vtOflLhP4fU-k98w"
|
||||||
|
nickname="Ahmed"
|
||||||
|
subject="Customise conflict resolution behaviour"
|
||||||
|
date="2014-02-25T11:42:08Z"
|
||||||
|
content="""
|
||||||
|
How to customise git-annex conflict resolution behaviour, such that for example: change naming convention of conflicted files with suffix or prefix, move conflicted files to another directory structure, overwrite conflicted files from preferred content ...
|
||||||
|
|
||||||
|
|
||||||
|
"""]]
|
|
@ -0,0 +1,8 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="https://www.google.com/accounts/o8/id?id=AItOawlm_3m5gLhML9bHbZ8FpJ-HBZhWaRfFeO8"
|
||||||
|
nickname="Corey"
|
||||||
|
subject="I got this error too."
|
||||||
|
date="2014-02-25T17:23:33Z"
|
||||||
|
content="""
|
||||||
|
With the armel tarbell downloaded 2014-02-21 on an Ubuntu (precise) chroot running on a Chromebook.
|
||||||
|
"""]]
|
|
@ -0,0 +1,16 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="https://www.google.com/accounts/o8/id?id=AItOawm78jq1Uo-ZbyOPG3diJUWVvEiM0kyAcvk"
|
||||||
|
nickname="Dorian"
|
||||||
|
subject="any ideas or questions?"
|
||||||
|
date="2014-02-25T13:41:16Z"
|
||||||
|
content="""
|
||||||
|
Hey Joey,
|
||||||
|
|
||||||
|
I was wondering if you had any idea how we could fix this problem or if you need further information on this.
|
||||||
|
Any response would be appreciated.
|
||||||
|
|
||||||
|
Thanks for your great work on git-annex!
|
||||||
|
|
||||||
|
Cheers,
|
||||||
|
Dorian
|
||||||
|
"""]]
|
4
doc/devblog/day_122_more_windows_porting.mdwn
Normal file
4
doc/devblog/day_122_more_windows_porting.mdwn
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
More windows porting. Made the build completely -Wall safe on Windows.
|
||||||
|
Fixed some DOS path separator bugs that were preventing WebDav from
|
||||||
|
working. Have now tested both box.com and Amazon S3 to be completely
|
||||||
|
working in the webapp on Windows.
|
|
@ -0,0 +1,7 @@
|
||||||
|
on a Mac OSX 10.9.1 client I would like to try out git-annex.
|
||||||
|
|
||||||
|
I download the latest Mavericks build, extract from the .dmg and it just does not run. I open the program, one "bounce" on the dock and it is gone, nothing happens.
|
||||||
|
|
||||||
|
I sadly do not have another OSX client to try it on. But nothing shows in the Console.app or anything.
|
||||||
|
|
||||||
|
Am I missing something?
|
|
@ -1525,8 +1525,7 @@ Here are all the supported configuration settings.
|
||||||
|
|
||||||
* `annex.web-options`
|
* `annex.web-options`
|
||||||
|
|
||||||
Options to use when using wget or curl to download a file from the web.
|
Options to pass when running wget or curl.
|
||||||
(wget is always used in preference to curl if available.)
|
|
||||||
For example, to force ipv4 only, set it to "-4"
|
For example, to force ipv4 only, set it to "-4"
|
||||||
|
|
||||||
* `annex.quvi-options`
|
* `annex.quvi-options`
|
||||||
|
|
|
@ -30,6 +30,8 @@ now! --[[Joey]]
|
||||||
(and possibly gpg) are not prompted there anymore.
|
(and possibly gpg) are not prompted there anymore.
|
||||||
|
|
||||||
* Local pairing seems to fail, after acking on Linux box, it stalls.
|
* Local pairing seems to fail, after acking on Linux box, it stalls.
|
||||||
|
(Also, of course, the Windows box is unlikely to have a ssh server,
|
||||||
|
so only pairing with a !Windows box will work.)
|
||||||
|
|
||||||
* gcrypt is not ported to windows (and as a shell script, may need
|
* gcrypt is not ported to windows (and as a shell script, may need
|
||||||
to be rewritten)
|
to be rewritten)
|
||||||
|
@ -43,9 +45,6 @@ now! --[[Joey]]
|
||||||
|
|
||||||
## minor problems
|
## minor problems
|
||||||
|
|
||||||
* Does not work with Cygwin's build of git (that git does not consistently
|
|
||||||
support use of DOS style paths, which git-annex uses on Windows).
|
|
||||||
Must use Msysgit.
|
|
||||||
* rsync special remotes with a rsyncurl of a local directory are known
|
* rsync special remotes with a rsyncurl of a local directory are known
|
||||||
buggy. (git-annex tells rsync C:foo and it thinks it means a remote host
|
buggy. (git-annex tells rsync C:foo and it thinks it means a remote host
|
||||||
named C...)
|
named C...)
|
||||||
|
@ -58,7 +57,6 @@ now! --[[Joey]]
|
||||||
|
|
||||||
## stuff needing testing
|
## stuff needing testing
|
||||||
|
|
||||||
* test S3 and box.com setup in webapp now that they should work..
|
|
||||||
* test that adding a repo on a removable drive works; that git is synced to
|
* test that adding a repo on a removable drive works; that git is synced to
|
||||||
it and files can be transferred to it and back
|
it and files can be transferred to it and back
|
||||||
* Does stopping in progress transfers work in the webapp?
|
* Does stopping in progress transfers work in the webapp?
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue