diff options
| -rw-r--r-- | Annex.hs | 3 | ||||
| -rw-r--r-- | Annex/Transfer.hs | 178 | ||||
| -rw-r--r-- | Assistant/Alert/Utility.hs | 1 | ||||
| -rw-r--r-- | BuildFlags.hs | 3 | ||||
| -rw-r--r-- | CmdLine/Option.hs | 6 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 11 | ||||
| -rw-r--r-- | Command/Get.hs | 20 | ||||
| -rw-r--r-- | Command/List.hs | 4 | ||||
| -rw-r--r-- | Command/Move.hs | 14 | ||||
| -rw-r--r-- | Command/SendKey.hs | 2 | ||||
| -rw-r--r-- | Command/TransferKey.hs | 10 | ||||
| -rw-r--r-- | Command/TransferKeys.hs | 9 | ||||
| -rw-r--r-- | Common.hs | 1 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 102 | ||||
| -rw-r--r-- | Remote/Git.hs | 6 | ||||
| -rw-r--r-- | Types/DesktopNotify.hs | 27 | ||||
| -rw-r--r-- | Utility/WebApp.hs | 1 | ||||
| -rw-r--r-- | debian/changelog | 5 | ||||
| -rw-r--r-- | debian/control | 1 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 13 | ||||
| -rw-r--r-- | git-annex.cabal | 10 |
21 files changed, 285 insertions, 142 deletions
@@ -60,6 +60,7 @@ import Types.FileMatcher import Types.NumCopies import Types.LockPool import Types.MetaData +import Types.DesktopNotify import Types.CleanupActions import qualified Utility.Matcher import qualified Data.Map as M @@ -122,6 +123,7 @@ data AnnexState = AnnexState , unusedkeys :: Maybe (S.Set Key) , quviversion :: Maybe QuviVersion , existinghooks :: M.Map Git.Hook.Hook Bool + , desktopnotify :: DesktopNotify } newState :: GitConfig -> Git.Repo -> AnnexState @@ -163,6 +165,7 @@ newState c r = AnnexState , unusedkeys = Nothing , quviversion = Nothing , existinghooks = M.empty + , desktopnotify = mempty } {- Makes an Annex state object for the specified git repo. diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs new file mode 100644 index 000000000..dac32e752 --- /dev/null +++ b/Annex/Transfer.hs @@ -0,0 +1,178 @@ +{- git-annex transfers + - + - Copyright 2012-2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Annex.Transfer ( + module X, + upload, + download, + runTransfer, + notifyTransfer, + NotifyWitness, + noRetry, + forwardRetry, +) where + +import qualified Annex +import Logs.Transfer as X +import Annex.Perms +import Annex.Exception +import Utility.Metered +#ifdef WITH_DBUS_NOTIFICATIONS +import Common.Annex +import Types.DesktopNotify +import qualified DBus.Notify as Notify +import qualified DBus.Client +#endif +#ifdef mingw32_HOST_OS +import Utility.WinLock +#endif + +import Control.Concurrent + +upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> NotifyWitness -> Annex Bool +upload u key f d a _witness = runTransfer (Transfer Upload u key) f d a + +download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> NotifyWitness -> Annex Bool +download u key f d a _witness = runTransfer (Transfer Download u key) f d a + +{- Runs a transfer action. Creates and locks the lock file while the + - action is running, and stores info in the transfer information + - file. + - + - If the transfer action returns False, the transfer info is + - left in the failedTransferDir. + - + - If the transfer is already in progress, returns False. + - + - An upload can be run from a read-only filesystem, and in this case + - no transfer information or lock file is used. + -} +runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool +runTransfer t file shouldretry a = do + info <- liftIO $ startTransferInfo file + (meter, tfile, metervar) <- mkProgressUpdater t info + mode <- annexFileMode + (fd, inprogress) <- liftIO $ prep tfile mode info + if inprogress + then do + showNote "transfer already in progress" + return False + else do + ok <- retry info metervar $ + bracketIO (return fd) (cleanup tfile) (const $ a meter) + unless ok $ recordFailedTransfer t info + return ok + where +#ifndef mingw32_HOST_OS + prep tfile mode info = do + mfd <- catchMaybeIO $ + openFd (transferLockFile tfile) ReadWrite (Just mode) + defaultFileFlags { trunc = True } + case mfd of + Nothing -> return (Nothing, False) + Just fd -> do + locked <- catchMaybeIO $ + setLock fd (WriteLock, AbsoluteSeek, 0, 0) + if isNothing locked + then return (Nothing, True) + else do + void $ tryIO $ writeTransferInfoFile info tfile + return (mfd, False) +#else + prep tfile _mode info = do + v <- catchMaybeIO $ lockExclusive (transferLockFile tfile) + case v of + Nothing -> return (Nothing, False) + Just Nothing -> return (Nothing, True) + Just (Just lockhandle) -> do + void $ tryIO $ writeTransferInfoFile info tfile + return (Just lockhandle, False) +#endif + cleanup _ Nothing = noop + cleanup tfile (Just lockhandle) = do + void $ tryIO $ removeFile tfile +#ifndef mingw32_HOST_OS + void $ tryIO $ removeFile $ transferLockFile tfile + closeFd lockhandle +#else + {- Windows cannot delete the lockfile until the lock + - is closed. So it's possible to race with another + - process that takes the lock before it's removed, + - so ignore failure to remove. + -} + dropLock lockhandle + void $ tryIO $ removeFile $ transferLockFile tfile +#endif + retry oldinfo metervar run = do + v <- tryAnnex run + case v of + Right b -> return b + Left _ -> do + b <- getbytescomplete metervar + let newinfo = oldinfo { bytesComplete = Just b } + if shouldretry oldinfo newinfo + then retry newinfo metervar run + else return False + getbytescomplete metervar + | transferDirection t == Upload = + liftIO $ readMVar metervar + | otherwise = do + f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t) + liftIO $ catchDefaultIO 0 $ + fromIntegral . fileSize <$> getFileStatus f + +type RetryDecider = TransferInfo -> TransferInfo -> Bool + +noRetry :: RetryDecider +noRetry _ _ = False + +{- Retries a transfer when it fails, as long as the failed transfer managed + - to send some data. -} +forwardRetry :: RetryDecider +forwardRetry old new = bytesComplete old < bytesComplete new + +-- Witness that notification has happened. +data NotifyWitness = NotifyWitness + +{- Wrap around an action that performs a transfer, which may run multiple + - attempts, and displays notification when supported. -} +notifyTransfer :: Direction -> Maybe FilePath -> (NotifyWitness -> Annex Bool) -> Annex Bool +notifyTransfer _ Nothing a = a NotifyWitness +notifyTransfer direction (Just f) a = do +#ifdef WITH_DBUS_NOTIFICATIONS + wanted <- Annex.getState Annex.desktopnotify + let action = if direction == Upload then "uploading" else "downloading" + let basedesc = action ++ " " ++ f + let startdesc = "started " ++ basedesc + let enddesc = "finished " ++ basedesc + if (notifyStart wanted || notifyFinish wanted) + then do + client <- liftIO DBus.Client.connectSession + let mknote desc = Notify.blankNote + { Notify.appName = "git-annex" + , Notify.body = Just $ Notify.Text desc + , Notify.hints = + [ Notify.Category Notify.Transfer + , Notify.Urgency Notify.Low + , Notify.SuppressSound True + ] + } + startnotification <- liftIO $ if notifyStart wanted + then Just <$> Notify.notify client (mknote startdesc) + else pure Nothing + r <- a NotifyWitness + when (notifyFinish wanted) $ liftIO $ void $ maybe + (Notify.notify client $ mknote enddesc) + (\n -> Notify.replace client n $ mknote enddesc) + startnotification + return r + else a NotifyWitness +#else + a NotifyWitness +#endif diff --git a/Assistant/Alert/Utility.hs b/Assistant/Alert/Utility.hs index 73843be4c..be631e999 100644 --- a/Assistant/Alert/Utility.hs +++ b/Assistant/Alert/Utility.hs @@ -14,7 +14,6 @@ import Utility.Tense import qualified Data.Text as T import Data.Text (Text) import qualified Data.Map as M -import Data.Monoid {- This is as many alerts as it makes sense to display at a time. - A display might be smaller, or larger, the point is to not overwhelm the diff --git a/BuildFlags.hs b/BuildFlags.hs index e36cf6a14..59a060cb5 100644 --- a/BuildFlags.hs +++ b/BuildFlags.hs @@ -57,6 +57,9 @@ buildFlags = filter (not . null) #ifdef WITH_DBUS , "DBus" #endif +#ifdef WITH_DESKTOP_NOTIFY + , "DesktopNotify" +#endif #ifdef WITH_XMPP , "XMPP" #else diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs index 915b06849..ce44d2ace 100644 --- a/CmdLine/Option.hs +++ b/CmdLine/Option.hs @@ -20,6 +20,7 @@ import System.Console.GetOpt import Common.Annex import qualified Annex import Types.Messages +import Types.DesktopNotify import Limit import CmdLine.Usage @@ -41,6 +42,10 @@ commonOptions = "don't show debug messages" , Option ['b'] ["backend"] (ReqArg setforcebackend paramName) "specify key-value backend to use" + , Option [] ["notify-finish"] (NoArg (setdesktopnotify mkNotifyFinish)) + "show desktop notification after transfer finishes" + , Option [] ["notify-start"] (NoArg (setdesktopnotify mkNotifyStart)) + "show desktop notification after transfer completes" ] where setforce v = Annex.changeState $ \s -> s { Annex.force = v } @@ -49,6 +54,7 @@ commonOptions = setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True } unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False } + setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v } matcherOptions :: [Option] matcherOptions = diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index a0978a88d..1c73cd24f 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -26,7 +26,7 @@ import Types.KeySource import Config import Annex.Content.Direct import Logs.Location -import qualified Logs.Transfer as Transfer +import qualified Annex.Transfer as Transfer #ifdef WITH_QUVI import Annex.Quvi import qualified Utility.Quvi as Quvi @@ -116,9 +116,10 @@ addUrlFileQuvi relaxed quviurl videourl file = do prepGetViaTmpChecked sizedkey $ do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput - ok <- Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do - liftIO $ createDirectoryIfMissing True (parentDir tmp) - downloadUrl [videourl] tmp + ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ + Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do + liftIO $ createDirectoryIfMissing True (parentDir tmp) + downloadUrl [videourl] tmp if ok then cleanup quviurl file key (Just tmp) else return False @@ -179,7 +180,7 @@ download url file = do , return False ) where - runtransfer dummykey tmp = + runtransfer dummykey tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ Transfer.download webUUID dummykey (Just file) Transfer.forwardRetry $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [url] tmp diff --git a/Command/Get.hs b/Command/Get.hs index f436b15b5..bef466724 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -11,7 +11,7 @@ import Common.Annex import Command import qualified Remote import Annex.Content -import Logs.Transfer +import Annex.Transfer import Config.NumCopies import Annex.Wanted import qualified Command.Move @@ -69,15 +69,15 @@ getKeyFile' key afile dest = dispatch showNote "not available" showlocs return False - dispatch remotes = trycopy remotes remotes - trycopy full [] = do + dispatch remotes = notifyTransfer Download afile $ trycopy remotes remotes + trycopy full [] _ = do Remote.showTriedRemotes full showlocs return False - trycopy full (r:rs) = + trycopy full (r:rs) witness = ifM (probablyPresent r) - ( docopy r (trycopy full rs) - , trycopy full rs + ( docopy r witness <||> trycopy full rs witness + , trycopy full rs witness ) showlocs = Remote.showLocations key [] "No other repository is known to contain the file." @@ -87,8 +87,6 @@ getKeyFile' key afile dest = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r continue = do - ok <- download (Remote.uuid r) key afile noRetry $ \p -> do - showAction $ "from " ++ Remote.name r - Remote.retrieveKeyFile r key afile dest p - if ok then return ok else continue + docopy r = download (Remote.uuid r) key afile noRetry $ \p -> do + showAction $ "from " ++ Remote.name r + Remote.retrieveKeyFile r key afile dest p diff --git a/Command/List.hs b/Command/List.hs index ba6251333..1fa206405 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -38,7 +38,7 @@ seek ps = do getList :: Annex [(UUID, RemoteName, TrustLevel)] getList = ifM (Annex.getFlag $ optionName allrepos) - ( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAll) + ( nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs) , getRemotes ) where @@ -48,7 +48,7 @@ getList = ifM (Annex.getFlag $ optionName allrepos) hereu <- getUUID heretrust <- lookupTrust hereu return $ (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts - getAll = do + getAllUUIDs = do rs <- M.toList <$> uuidMap rs3 <- forM rs $ \(u, n) -> (,,) <$> pure u diff --git a/Command/Move.hs b/Command/Move.hs index 3a39e1de0..206a875b7 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -14,8 +14,8 @@ import qualified Annex import Annex.Content import qualified Remote import Annex.UUID +import Annex.Transfer import Logs.Presence -import Logs.Transfer def :: [Command] def = [withOptions moveOptions $ command "move" paramPaths seek @@ -98,8 +98,9 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $ stop Right False -> do showAction $ "to " ++ Remote.name dest - ok <- upload (Remote.uuid dest) key afile noRetry $ - Remote.storeKey dest key afile + ok <- notifyTransfer Upload afile $ + upload (Remote.uuid dest) key afile noRetry $ + Remote.storeKey dest key afile if ok then do Remote.logStatus dest key InfoPresent @@ -155,9 +156,10 @@ fromPerform src move key afile = moveLock move key $ , handle move =<< go ) where - go = download (Remote.uuid src) key afile noRetry $ \p -> do - showAction $ "from " ++ Remote.name src - getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p + go = notifyTransfer Download afile $ + download (Remote.uuid src) key afile noRetry $ \p -> do + showAction $ "from " ++ Remote.name src + getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p handle _ False = stop -- failed handle False True = next $ return True -- copy complete handle True True = do -- finish moving diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 2215b16b2..a201d1b89 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -12,7 +12,7 @@ import Command import Annex.Content import Annex import Utility.Rsync -import Logs.Transfer +import Annex.Transfer import qualified CmdLine.GitAnnexShell.Fields as Fields import Utility.Metered diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index b6b237467..13bfd825e 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -11,7 +11,7 @@ import Common.Annex import Command import Annex.Content import Logs.Location -import Logs.Transfer +import Annex.Transfer import qualified Remote import Types.Remote @@ -41,7 +41,7 @@ start to from file key = _ -> error "specify either --from or --to" toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -toPerform remote key file = go $ +toPerform remote key file = go Upload file $ upload (uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ @@ -49,9 +49,9 @@ toPerform remote key file = go $ return ok fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform -fromPerform remote key file = go $ +fromPerform remote key file = go Upload file $ download (uuid remote) key file forwardRetry $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p -go :: Annex Bool -> CommandPerform -go a = a >>= liftIO . exitBool +go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform +go direction file a = notifyTransfer direction file a >>= liftIO . exitBool diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index b42628609..8f4498eb1 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -13,7 +13,7 @@ import Common.Annex import Command import Annex.Content import Logs.Location -import Logs.Transfer +import Annex.Transfer import qualified Remote import Types.Key @@ -34,14 +34,15 @@ start = withHandles $ \(readh, writeh) -> do stop where runner (TransferRequest direction remote key file) - | direction == Upload = + | direction == Upload = notifyTransfer direction file $ upload (Remote.uuid remote) key file forwardRetry $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent return ok - | otherwise = download (Remote.uuid remote) key file forwardRetry $ \p -> - getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p + | otherwise = notifyTransfer direction file $ + download (Remote.uuid remote) key file forwardRetry $ \p -> + getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p {- stdin and stdout are connected with the caller, to be used for - communication with it. But doing a transfer might involve something @@ -11,6 +11,7 @@ import Control.Exception.Extensible as X (IOException) import Data.Maybe as X import Data.List as X hiding (head, tail, init, last) import Data.String.Utils as X hiding (join) +import Data.Monoid as X import System.FilePath as X import System.Directory as X diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 742bdc7b9..c96d9cd1e 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -88,108 +88,6 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage percentComplete (Transfer { transferKey = key }) info = percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info) -type RetryDecider = TransferInfo -> TransferInfo -> Bool - -noRetry :: RetryDecider -noRetry _ _ = False - -{- Retries a transfer when it fails, as long as the failed transfer managed - - to send some data. -} -forwardRetry :: RetryDecider -forwardRetry old new = bytesComplete old < bytesComplete new - -upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool -upload u key = runTransfer (Transfer Upload u key) - -download :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool -download u key = runTransfer (Transfer Download u key) - -{- Runs a transfer action. Creates and locks the lock file while the - - action is running, and stores info in the transfer information - - file. - - - - If the transfer action returns False, the transfer info is - - left in the failedTransferDir. - - - - If the transfer is already in progress, returns False. - - - - An upload can be run from a read-only filesystem, and in this case - - no transfer information or lock file is used. - -} -runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool -runTransfer t file shouldretry a = do - info <- liftIO $ startTransferInfo file - (meter, tfile, metervar) <- mkProgressUpdater t info - mode <- annexFileMode - (fd, inprogress) <- liftIO $ prep tfile mode info - if inprogress - then do - showNote "transfer already in progress" - return False - else do - ok <- retry info metervar $ - bracketIO (return fd) (cleanup tfile) (const $ a meter) - unless ok $ recordFailedTransfer t info - return ok - where -#ifndef mingw32_HOST_OS - prep tfile mode info = do - mfd <- catchMaybeIO $ - openFd (transferLockFile tfile) ReadWrite (Just mode) - defaultFileFlags { trunc = True } - case mfd of - Nothing -> return (Nothing, False) - Just fd -> do - locked <- catchMaybeIO $ - setLock fd (WriteLock, AbsoluteSeek, 0, 0) - if isNothing locked - then return (Nothing, True) - else do - void $ tryIO $ writeTransferInfoFile info tfile - return (mfd, False) -#else - prep tfile _mode info = do - v <- catchMaybeIO $ lockExclusive (transferLockFile tfile) - case v of - Nothing -> return (Nothing, False) - Just Nothing -> return (Nothing, True) - Just (Just lockhandle) -> do - void $ tryIO $ writeTransferInfoFile info tfile - return (Just lockhandle, False) -#endif - cleanup _ Nothing = noop - cleanup tfile (Just lockhandle) = do - void $ tryIO $ removeFile tfile -#ifndef mingw32_HOST_OS - void $ tryIO $ removeFile $ transferLockFile tfile - closeFd lockhandle -#else - {- Windows cannot delete the lockfile until the lock - - is closed. So it's possible to race with another - - process that takes the lock before it's removed, - - so ignore failure to remove. - -} - dropLock lockhandle - void $ tryIO $ removeFile $ transferLockFile tfile -#endif - retry oldinfo metervar run = do - v <- tryAnnex run - case v of - Right b -> return b - Left _ -> do - b <- getbytescomplete metervar - let newinfo = oldinfo { bytesComplete = Just b } - if shouldretry oldinfo newinfo - then retry newinfo metervar run - else return False - getbytescomplete metervar - | transferDirection t == Upload = - liftIO $ readMVar metervar - | otherwise = do - f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t) - liftIO $ catchDefaultIO 0 $ - fromIntegral . fileSize <$> getFileStatus f - {- Generates a callback that can be called as transfer progresses to update - the transfer info file. Also returns the file it'll be updating, and a - MVar that can be used to read the number of bytesComplete. -} diff --git a/Remote/Git.hs b/Remote/Git.hs index 995d66779..209312d67 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -24,7 +24,7 @@ import qualified Git.Command import qualified Git.GCrypt import qualified Annex import Logs.Presence -import Logs.Transfer +import Annex.Transfer import Annex.UUID import Annex.Exception import qualified Annex.Content @@ -321,7 +321,7 @@ copyFromRemote' r key file dest case v of Nothing -> return False Just (object, checksuccess) -> - upload u key file noRetry + runTransfer (Transfer Download u key) file noRetry (rsyncOrCopyFile params object dest) <&&> checksuccess | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do @@ -418,7 +418,7 @@ copyToRemote r key file p ( return True , do ensureInitialized - download u key file noRetry $ const $ + runTransfer (Transfer Download u key) file noRetry $ const $ Annex.Content.saveState True `after` Annex.Content.getViaTmpChecked (liftIO checksuccessio) key (\d -> rsyncOrCopyFile params object d p) diff --git a/Types/DesktopNotify.hs b/Types/DesktopNotify.hs new file mode 100644 index 000000000..f8494487d --- /dev/null +++ b/Types/DesktopNotify.hs @@ -0,0 +1,27 @@ +{- git-annex DesktopNotify type + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.DesktopNotify where + +import Data.Monoid + +data DesktopNotify = DesktopNotify + { notifyStart :: Bool + , notifyFinish :: Bool + } + deriving (Show) + +instance Monoid DesktopNotify where + mempty = DesktopNotify False False + mappend (DesktopNotify s1 f1) (DesktopNotify s2 f2) = + DesktopNotify (s1 || s2) (f1 || f2) + +mkNotifyStart :: DesktopNotify +mkNotifyStart = DesktopNotify True False + +mkNotifyFinish :: DesktopNotify +mkNotifyFinish = DesktopNotify False True diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 8e08ab9e0..1a7698870 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -33,7 +33,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Blaze.ByteString.Builder.Char.Utf8 (fromText) import Blaze.ByteString.Builder (Builder) -import Data.Monoid import Control.Arrow ((***)) import Control.Concurrent #ifdef WITH_WEBAPP_SECURE diff --git a/debian/changelog b/debian/changelog index cb70aeaa7..51629cd93 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,11 @@ git-annex (5.20140321) UNRELEASED; urgency=medium * unannex, uninit: Avoid committing after every file is unannexed, for massive speedup. + * --notify-finish switch will cause desktop notifications after each + file upload/download compltes + (using the dbus Desktop Notifications Specification) + * --notify-start switch will show desktop notifications when each + file upload/download starts. -- Joey Hess <joeyh@debian.org> Fri, 21 Mar 2014 14:08:41 -0400 diff --git a/debian/control b/debian/control index 9b6e812b8..dd7eaa848 100644 --- a/debian/control +++ b/debian/control @@ -30,6 +30,7 @@ Build-Depends: libghc-hinotify-dev [linux-any], libghc-stm-dev (>= 2.3), libghc-dbus-dev (>= 0.10.3) [linux-any], + libghc-fdo-notify-dev (>= 0.3) [linux-any], libghc-yesod-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-yesod-static-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], libghc-yesod-default-dev [i386 amd64 kfreebsd-amd64 powerpc sparc], diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 32c8ec266..894ac4329 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1053,6 +1053,19 @@ subdirectories). Overrides the User-Agent to use when downloading files from the web. +* `--notify-finish` + + Caused a desktop notification to be displayed after each successful + file download and upload. + + (Only supported on some platforms, eg Linux with dbus. A no-op when + not supported.) + +* `--notify-start` + + Caused a desktop notification to be displayed when a file upload + or download has started. + * `-c name=value` Overrides git configuration settings. May be specified multiple times. diff --git a/git-annex.cabal b/git-annex.cabal index 2ac1c4f13..0f8987915 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -85,6 +85,9 @@ Flag Tahoe Flag CryptoHash Description: Enable use of cryptohash for checksumming +Flag DesktopNotify + Description: Enable desktop environment notifications + Flag EKG Description: Enable use of EKG to monitor git-annex as it runs (at http://localhost:4242/) Default: False @@ -167,10 +170,15 @@ Executable git-annex CPP-Options: -DWITH_KQUEUE C-Sources: Utility/libkqueue.c - if os(linux) && flag(Dbus) + if flag(Dbus) Build-Depends: dbus (>= 0.10.3) CPP-Options: -DWITH_DBUS + if flag(DesktopNotify) + if flag(Dbus) + Build-Depends: dbus (>= 0.10.3), fdo-notify (>= 0.3) + CPP-Options: -DWITH_DESKTOP_NOTIFY -DWITH_DBUS_NOTIFICATIONS + if flag(Android) Build-Depends: data-endian CPP-Options: -D__ANDROID__ -DANDROID_SPLICES -D__NO_TH__ |