Merge branch 'master' of git://git-annex.branchable.com

This commit is contained in:
Richard Hartmann 2014-02-25 22:38:01 +01:00
commit 71426bf41c
25 changed files with 178 additions and 85 deletions

View file

@ -49,11 +49,13 @@ import Assistant.Threads.XMPPPusher
import Assistant.Types.UrlRenderer
#endif
import qualified Utility.Daemon
import Utility.LogFile
import Utility.ThreadScheduler
import Utility.HumanTime
import Annex.Perms
import qualified Build.SysConfig as SysConfig
#ifndef mingw32_HOST_OS
import Utility.LogFile
import Annex.Perms
#endif
import System.Log.Logger
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
Annex.changeState $ \s -> s { Annex.daemon = True }
pidfile <- fromRepo gitAnnexPidFile
logfile <- fromRepo gitAnnexLogFile
#ifndef mingw32_HOST_OS
logfile <- fromRepo gitAnnexLogFile
createAnnexDirectory (parentDir logfile)
logfd <- liftIO $ openLog logfile
if foreground
@ -93,11 +95,12 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
#else
-- Windows is always foreground, and has no log file.
liftIO $ Utility.Daemon.lockPidFile pidfile
start id $ do
case startbrowser of
Nothing -> Nothing
Just a -> Just $ a Nothing Nothing
when (foreground || not foreground) $ do
liftIO $ Utility.Daemon.lockPidFile pidfile
start id $ do
case startbrowser of
Nothing -> Nothing
Just a -> Just $ a Nothing Nothing
#endif
where
desc

View file

@ -24,8 +24,10 @@ import DBus
import Data.Word (Word32)
import Assistant.NetMessager
#else
#ifdef linux_HOST_OS
#warning Building without dbus support; will poll for network connection changes
#endif
#endif
netWatcherThread :: NamedThread
#if WITH_DBUS

View file

@ -27,7 +27,6 @@ import qualified Git.Command
import qualified Git.Config
import Utility.ThreadScheduler
import qualified Assistant.Threads.Watcher as Watcher
import Utility.LogFile
import Utility.Batch
import Utility.NotificationBroadcaster
import Config
@ -43,6 +42,9 @@ import qualified Annex
#ifdef WITH_WEBAPP
import Assistant.WebApp.Types
#endif
#ifndef mingw32_HOST_OS
import Utility.LogFile
#endif
import Data.Time.Clock.POSIX
import qualified Data.Text as T
@ -214,10 +216,10 @@ checkLogSize n = do
checkLogSize $ n + 1
where
filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)
#endif
oneMegabyte :: Int
oneMegabyte = 1000000
oneMegabyte :: Int
oneMegabyte = 1000000
#endif
oneHour :: Int
oneHour = 60 * 60

View file

@ -23,7 +23,6 @@ import Assistant.Types.Changes
import Assistant.Alert
import Utility.DirWatcher
import Utility.DirWatcher.Types
import qualified Utility.Lsof as Lsof
import qualified Annex
import qualified Annex.Queue
import qualified Git
@ -40,6 +39,9 @@ import Annex.ReplaceFile
import Git.Types
import Config
import Utility.ThreadScheduler
#ifndef mingw32_HOST_OS
import qualified Utility.Lsof as Lsof
#endif
import Data.Bits.Utils
import Data.Typeable

View file

@ -114,9 +114,9 @@ checkRepositoryPath p = do
- browsed to a directory with git-annex and run it from there. -}
defaultRepositoryPath :: Bool -> IO FilePath
defaultRepositoryPath firstrun = do
cwd <- liftIO getCurrentDirectory
home <- myHomeDir
#ifndef mingw32_HOST_OS
home <- myHomeDir
cwd <- liftIO getCurrentDirectory
if home == cwd && firstrun
then inhome
else ifM (legit cwd <&&> canWrite cwd)
@ -127,7 +127,7 @@ defaultRepositoryPath firstrun = do
-- On Windows, always default to ~/Desktop/annex or ~/annex,
-- no cwd handling because the user might be able to write
-- to the entire drive.
inhome
if firstrun then inhome else inhome
#endif
where
inhome = do
@ -136,9 +136,11 @@ defaultRepositoryPath firstrun = do
( relHome $ desktop </> gitAnnexAssistantDefaultDir
, return $ "~" </> gitAnnexAssistantDefaultDir
)
#ifndef mingw32_HOST_OS
-- Avoid using eg, standalone build's git-annex.linux/ directory
-- when run from there.
legit d = not <$> doesFileExist (d </> "git-annex")
#endif
newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do

View file

@ -12,7 +12,6 @@ module Assistant.WebApp.Configurators.Pairing where
import Assistant.Pairing
import Assistant.WebApp.Common
import Assistant.WebApp.Configurators
import Assistant.Types.Buddies
import Annex.UUID
#ifdef WITH_PAIRING
@ -32,6 +31,7 @@ import Network.Protocol.XMPP
import Assistant.Types.NetMessager
import Assistant.NetMessager
import Assistant.WebApp.RepoList
import Assistant.WebApp.Configurators
import Assistant.WebApp.Configurators.XMPP
#endif
import Utility.UserInfo

View file

@ -218,15 +218,15 @@ link file key mcache = flip catchAnnex (undo file key) $ do
l <- inRepo $ gitAnnexLink file key
replaceFile file $ makeAnnexLink l
#ifdef WITH_CLIBS
#ifndef __ANDROID__
-- touch symlink to have same time as the original file,
-- as provided in the InodeCache
case mcache of
#if defined(WITH_CLIBS) && ! defined(__ANDROID__)
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
#else
Just _ -> noop
#endif
Nothing -> noop
#endif
#endif
return l

View file

@ -466,7 +466,8 @@ getFsckTime key = do
- To guard against time stamp damange (for example, if an annex directory
- is copied without -a), the fsckstate file contains a time that should
- 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 = do
@ -477,10 +478,10 @@ recordStartTime = do
withFile f WriteMode $ \h -> do
#ifndef mingw32_HOST_OS
t <- modificationTime <$> getFileStatus f
hPutStr h $ showTime $ realToFrac t
#else
noop
t <- getPOSIXTime
#endif
hPutStr h $ showTime $ realToFrac t
where
showTime :: POSIXTime -> String
showTime = show
@ -494,15 +495,18 @@ getStartTime = do
f <- fromRepo gitAnnexFsckState
liftIO $ catchDefaultIO Nothing $ do
timestamp <- modificationTime <$> getFileStatus f
#ifndef mingw32_HOST_OS
t <- readishTime <$> readFile f
return $ if Just (realToFrac timestamp) == t
let fromstatus = Just (realToFrac timestamp)
fromfile <- readishTime <$> readFile f
return $ if matchingtimestamp fromfile fromstatus
then Just timestamp
else Nothing
#else
return $ Just timestamp
#endif
where
readishTime :: String -> Maybe POSIXTime
readishTime s = utcTimeToPOSIXSeconds <$>
parseTime defaultTimeLocale "%s%Qs" s
matchingtimestamp fromfile fromstatus =
#ifndef mingw32_HOST_OS
fromfile == fromstatus
#else
fromfile >= fromstatus
#endif

View file

@ -15,9 +15,6 @@ import Common
import Git
import Git.Types
import qualified Utility.CoProcess as CoProcess
#ifdef mingw32_HOST_OS
import Git.FilePath
#endif
import Utility.Batch
{- Constructs a git command line operating on the specified repo. -}

View file

@ -17,16 +17,17 @@ module Git.Queue (
flush,
) where
import qualified Data.Map as M
import System.IO
import System.Process
import Utility.SafeCommand
import Common
import Git
import Git.Command
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.
-}
data Action
@ -147,8 +148,9 @@ runAction :: Repo -> Action -> IO ()
runAction repo (UpdateIndexAction streamers) =
-- list is stored in reverse order
Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers
runAction repo action@(CommandAction {}) =
runAction repo action@(CommandAction {}) = do
#ifndef mingw32_HOST_OS
let p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
withHandle StdinHandle createProcessSuccess p $ \h -> do
fileEncoding h
hPutStr h $ intercalate "\0" $ toCommand $ getFiles action
@ -162,6 +164,5 @@ runAction repo action@(CommandAction {}) =
void $ boolSystem "git" (gitparams ++ [f])
#endif
where
p = (proc "xargs" $ "-0":"git":toCommand gitparams) { env = gitEnv repo }
gitparams = gitCommandLine
(Param (getSubcommand action):getParams action) repo

View file

@ -285,7 +285,7 @@ keyUrls r key = map tourl locs'
#ifndef mingw32_HOST_OS
locs' = locs
#else
locs' = map (replace "\\" "/") (annexLocations key)
locs' = map (replace "\\" "/") locs
#endif
dropKey :: Remote -> Key -> Annex Bool

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)
@ -23,6 +22,7 @@ import Network.HTTP.Client (HttpException(..))
import Network.HTTP.Conduit (HttpException(..))
#endif
import Network.HTTP.Types
import System.Log.Logger (debugM)
import System.IO.Error
import Common.Annex
@ -38,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
@ -235,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 ()
@ -270,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 ()
@ -311,12 +293,16 @@ contentType = Just $ B8.fromString "application/octet-stream"
throwIO :: String -> IO a
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.
---------------------------------------------------------------------}
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)
goDAV url user pass $ putContentM (contentType, b)
#else
@ -324,7 +310,9 @@ putDAV url user pass b =
#endif
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
#if MIN_VERSION_DAV(0,6,0)
go = goDAV url user pass $ snd <$> getContentM
@ -333,7 +321,8 @@ getDAV url user pass = eitherToMaybe <$> tryNonAsync go
#endif
deleteDAV :: DavUrl -> DavUser -> DavPass -> IO ()
deleteDAV url user pass =
deleteDAV url user pass = do
debugDAV "DELETE" url
#if MIN_VERSION_DAV(0,6,0)
goDAV url user pass delContentM
#else
@ -341,7 +330,8 @@ deleteDAV url user pass =
#endif
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)
goDAV url user pass $ moveContentM newurl'
#else
@ -351,7 +341,8 @@ moveDAV url newurl user pass =
newurl' = B8.fromString newurl
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)
goDAV url user pass mkCol
#else
@ -359,7 +350,9 @@ mkdirDAV url user pass =
#endif
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
ispresent = return . Right
#if MIN_VERSION_DAV(0,6,0)

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

View file

@ -11,7 +11,9 @@ module Utility.LogFile where
import Common
#ifndef mingw32_HOST_OS
import System.Posix.Types
#endif
#ifndef mingw32_HOST_OS
openLog :: FilePath -> IO Fd

View file

@ -18,7 +18,6 @@ import Data.Char
import Control.Applicative
#ifdef mingw32_HOST_OS
import Data.Char
import qualified System.FilePath.Posix as Posix
#else
import System.Posix.Files

View file

@ -23,7 +23,6 @@ import Network.HTTP.Types
import System.Log.Logger
import qualified Data.CaseInsensitive as CI
import Network.Socket
import Control.Exception
import "crypto-api" Crypto.Random
import qualified Web.ClientSession as CS
import qualified Data.ByteString.Lazy as L
@ -39,6 +38,10 @@ import Control.Concurrent
#ifdef __ANDROID__
import Data.Endian
#endif
#if defined(__ANDROID__) || defined (mingw32_HOST_OS)
#else
import Control.Exception (bracketOnError)
#endif
localhost :: HostName
localhost = "localhost"

View file

@ -11,9 +11,5 @@ module Utility.WinProcess where
import Utility.PID
import System.Win32.Process
import Foreign.C
import Control.Exception
foreign import ccall unsafe "terminatepid"
terminatePID :: PID -> IO ()

15
debian/changelog vendored
View file

@ -1,28 +1,29 @@
git-annex (5.20140222) UNRELEASED; urgency=medium
* Fix handling of rsync remote urls containing a username,
including rsync.net.
* --metadata field=value can now use globs to match, and matches
case insensatively, the same as git annex view field=value does.
* metadata: Field names limited to alphanumerics and a few whitelisted
punctuation characters to avoid issues with views, etc.
* When constructing views, metadata is available about the location of the
file in the view's reference branch. Allows incorporating parts of the
directory hierarchy in a view.
For example `git annex view tag=* podcasts/=*` makes a view in the form
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
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.
* metadata: Field names limited to alphanumerics and a few whitelisted
punctuation characters to avoid issues with views, etc.
* metadata: Support --json
* webapp: Fix creation of box.com and Amazon S3 and Glacier
repositories, broken in 5.20140221.
* 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
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
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

View file

@ -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 ...
"""]]

View file

@ -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.
"""]]

View file

@ -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
"""]]

View 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.

View file

@ -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?

View file

@ -1525,8 +1525,7 @@ Here are all the supported configuration settings.
* `annex.web-options`
Options to use when using wget or curl to download a file from the web.
(wget is always used in preference to curl if available.)
Options to pass when running wget or curl.
For example, to force ipv4 only, set it to "-4"
* `annex.quvi-options`

View file

@ -30,6 +30,8 @@ now! --[[Joey]]
(and possibly gpg) are not prompted there anymore.
* 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
to be rewritten)
@ -43,9 +45,6 @@ now! --[[Joey]]
## 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
buggy. (git-annex tells rsync C:foo and it thinks it means a remote host
named C...)
@ -58,7 +57,6 @@ now! --[[Joey]]
## 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
it and files can be transferred to it and back
* Does stopping in progress transfers work in the webapp?