Merge branch 'master' into remotecontrol
Conflicts: debian/changelog
This commit is contained in:
commit
96ce2812e0
35 changed files with 392 additions and 126 deletions
3
.gitignore
vendored
3
.gitignore
vendored
|
@ -23,6 +23,9 @@ html
|
||||||
dist
|
dist
|
||||||
# Sandboxed builds
|
# Sandboxed builds
|
||||||
cabal-dev
|
cabal-dev
|
||||||
|
.cabal-sandbox
|
||||||
|
cabal.sandbox.config
|
||||||
|
cabal.config
|
||||||
# Project-local emacs configuration
|
# Project-local emacs configuration
|
||||||
.dir-locals.el
|
.dir-locals.el
|
||||||
# OSX related
|
# OSX related
|
||||||
|
|
8
Annex.hs
8
Annex.hs
|
@ -5,7 +5,7 @@
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports #-}
|
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, PackageImports #-}
|
||||||
|
|
||||||
module Annex (
|
module Annex (
|
||||||
Annex,
|
Annex,
|
||||||
|
@ -63,7 +63,9 @@ import Types.DesktopNotify
|
||||||
import Types.CleanupActions
|
import Types.CleanupActions
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
#ifdef WITH_QUVI
|
||||||
import Utility.Quvi (QuviVersion)
|
import Utility.Quvi (QuviVersion)
|
||||||
|
#endif
|
||||||
|
|
||||||
{- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.
|
{- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.
|
||||||
- This allows modifying the state in an exception-safe fashion.
|
- This allows modifying the state in an exception-safe fashion.
|
||||||
|
@ -117,7 +119,9 @@ data AnnexState = AnnexState
|
||||||
, useragent :: Maybe String
|
, useragent :: Maybe String
|
||||||
, errcounter :: Integer
|
, errcounter :: Integer
|
||||||
, unusedkeys :: Maybe (S.Set Key)
|
, unusedkeys :: Maybe (S.Set Key)
|
||||||
|
#ifdef WITH_QUVI
|
||||||
, quviversion :: Maybe QuviVersion
|
, quviversion :: Maybe QuviVersion
|
||||||
|
#endif
|
||||||
, existinghooks :: M.Map Git.Hook.Hook Bool
|
, existinghooks :: M.Map Git.Hook.Hook Bool
|
||||||
, desktopnotify :: DesktopNotify
|
, desktopnotify :: DesktopNotify
|
||||||
}
|
}
|
||||||
|
@ -160,7 +164,9 @@ newState c r = AnnexState
|
||||||
, useragent = Nothing
|
, useragent = Nothing
|
||||||
, errcounter = 0
|
, errcounter = 0
|
||||||
, unusedkeys = Nothing
|
, unusedkeys = Nothing
|
||||||
|
#ifdef WITH_QUVI
|
||||||
, quviversion = Nothing
|
, quviversion = Nothing
|
||||||
|
#endif
|
||||||
, existinghooks = M.empty
|
, existinghooks = M.empty
|
||||||
, desktopnotify = mempty
|
, desktopnotify = mempty
|
||||||
}
|
}
|
||||||
|
|
|
@ -45,7 +45,12 @@ bundledPrograms = catMaybes
|
||||||
#endif
|
#endif
|
||||||
, SysConfig.gpg
|
, SysConfig.gpg
|
||||||
, ifset SysConfig.curl "curl"
|
, ifset SysConfig.curl "curl"
|
||||||
|
#ifndef darwin_HOST_OS
|
||||||
|
-- wget on OSX has been problimatic, looking for certs in the wrong
|
||||||
|
-- places. Don't ship it, use curl or the OSX's own wget if it has
|
||||||
|
-- one.
|
||||||
, ifset SysConfig.wget "wget"
|
, ifset SysConfig.wget "wget"
|
||||||
|
#endif
|
||||||
, ifset SysConfig.bup "bup"
|
, ifset SysConfig.bup "bup"
|
||||||
, SysConfig.lsof
|
, SysConfig.lsof
|
||||||
, SysConfig.gcrypt
|
, SysConfig.gcrypt
|
||||||
|
|
|
@ -9,11 +9,12 @@ mkdir --parents dist/$sdist_dir
|
||||||
|
|
||||||
find . \( -name .git -or -name dist -or -name cabal-dev \) -prune \
|
find . \( -name .git -or -name dist -or -name cabal-dev \) -prune \
|
||||||
-or -not -name \\*.orig -not -type d -print \
|
-or -not -name \\*.orig -not -type d -print \
|
||||||
| perl -ne "print unless length >= 100 - length q{$sdist_dir}" \
|
| perl -ne "print unless length >= 100 - length q{$sdist_dir}" \
|
||||||
| xargs cp --parents --target-directory dist/$sdist_dir
|
| grep -v ':' \
|
||||||
|
| xargs cp --parents --target-directory dist/$sdist_dir
|
||||||
|
|
||||||
cd dist
|
cd dist
|
||||||
tar -caf $sdist_dir.tar.gz $sdist_dir
|
tar --format=ustar -caf $sdist_dir.tar.gz $sdist_dir
|
||||||
|
|
||||||
# Check that tarball can be unpacked by cabal.
|
# Check that tarball can be unpacked by cabal.
|
||||||
# It's picky about tar longlinks etc.
|
# It's picky about tar longlinks etc.
|
||||||
|
|
2
Makefile
2
Makefile
|
@ -140,7 +140,7 @@ OSXAPP_BASE=$(OSXAPP_DEST)/Contents/MacOS/bundle
|
||||||
osxapp: Build/Standalone Build/OSXMkLibs
|
osxapp: Build/Standalone Build/OSXMkLibs
|
||||||
$(MAKE) git-annex
|
$(MAKE) git-annex
|
||||||
|
|
||||||
rm -rf "$(OSXAPP_DEST)"
|
rm -rf "$(OSXAPP_DEST)" "$(OSXAPP_BASE)"
|
||||||
install -d tmp/build-dmg
|
install -d tmp/build-dmg
|
||||||
cp -R standalone/osx/git-annex.app "$(OSXAPP_DEST)"
|
cp -R standalone/osx/git-annex.app "$(OSXAPP_DEST)"
|
||||||
|
|
||||||
|
|
1
Test.hs
1
Test.hs
|
@ -164,6 +164,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
|
||||||
, testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
|
, testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
|
||||||
, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable
|
, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable
|
||||||
, testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
|
, testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips
|
||||||
|
, testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane
|
||||||
, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
|
, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips
|
||||||
, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane
|
, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane
|
||||||
, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize
|
, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize
|
||||||
|
|
|
@ -124,6 +124,9 @@ rsyncUrlIsPath s
|
||||||
- after the \r is the number of bytes processed. After the number,
|
- after the \r is the number of bytes processed. After the number,
|
||||||
- there must appear some whitespace, or we didn't get the whole number,
|
- there must appear some whitespace, or we didn't get the whole number,
|
||||||
- and return the \r and part we did get, for later processing.
|
- and return the \r and part we did get, for later processing.
|
||||||
|
-
|
||||||
|
- In some locales, the number will have one or more commas in the middle
|
||||||
|
- of it.
|
||||||
-}
|
-}
|
||||||
parseRsyncProgress :: String -> (Maybe Integer, String)
|
parseRsyncProgress :: String -> (Maybe Integer, String)
|
||||||
parseRsyncProgress = go [] . reverse . progresschunks
|
parseRsyncProgress = go [] . reverse . progresschunks
|
||||||
|
@ -142,7 +145,7 @@ parseRsyncProgress = go [] . reverse . progresschunks
|
||||||
parsebytes s = case break isSpace s of
|
parsebytes s = case break isSpace s of
|
||||||
([], _) -> Nothing
|
([], _) -> Nothing
|
||||||
(_, []) -> Nothing
|
(_, []) -> Nothing
|
||||||
(b, _) -> readish b
|
(b, _) -> readish $ filter (/= ',') b
|
||||||
|
|
||||||
{- Filters options to those that are safe to pass to rsync in server mode,
|
{- Filters options to those that are safe to pass to rsync in server mode,
|
||||||
- without causing it to eg, expose files. -}
|
- without causing it to eg, expose files. -}
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- scheduled activities
|
{- scheduled activities
|
||||||
-
|
-
|
||||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
- Copyright 2013-2014 Joey Hess <joey@kitenet.net>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -10,7 +10,12 @@ module Utility.Scheduled (
|
||||||
Recurrance(..),
|
Recurrance(..),
|
||||||
ScheduledTime(..),
|
ScheduledTime(..),
|
||||||
NextTime(..),
|
NextTime(..),
|
||||||
|
WeekDay,
|
||||||
|
MonthDay,
|
||||||
|
YearDay,
|
||||||
nextTime,
|
nextTime,
|
||||||
|
calcNextTime,
|
||||||
|
startTime,
|
||||||
fromSchedule,
|
fromSchedule,
|
||||||
fromScheduledTime,
|
fromScheduledTime,
|
||||||
toScheduledTime,
|
toScheduledTime,
|
||||||
|
@ -18,12 +23,17 @@ module Utility.Scheduled (
|
||||||
toRecurrance,
|
toRecurrance,
|
||||||
toSchedule,
|
toSchedule,
|
||||||
parseSchedule,
|
parseSchedule,
|
||||||
prop_schedule_roundtrips
|
prop_schedule_roundtrips,
|
||||||
|
prop_past_sane,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common
|
import Utility.Data
|
||||||
import Utility.QuickCheck
|
import Utility.QuickCheck
|
||||||
|
import Utility.PartialPrelude
|
||||||
|
import Utility.Misc
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Data.List
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.LocalTime
|
import Data.Time.LocalTime
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
|
@ -41,9 +51,9 @@ data Recurrance
|
||||||
| Weekly (Maybe WeekDay)
|
| Weekly (Maybe WeekDay)
|
||||||
| Monthly (Maybe MonthDay)
|
| Monthly (Maybe MonthDay)
|
||||||
| Yearly (Maybe YearDay)
|
| Yearly (Maybe YearDay)
|
||||||
-- Days, Weeks, or Months of the year evenly divisible by a number.
|
|
||||||
-- (Divisible Year is years evenly divisible by a number.)
|
|
||||||
| Divisible Int Recurrance
|
| Divisible Int Recurrance
|
||||||
|
-- ^ Days, Weeks, or Months of the year evenly divisible by a number.
|
||||||
|
-- (Divisible Year is years evenly divisible by a number.)
|
||||||
deriving (Eq, Read, Show, Ord)
|
deriving (Eq, Read, Show, Ord)
|
||||||
|
|
||||||
type WeekDay = Int
|
type WeekDay = Int
|
||||||
|
@ -58,8 +68,8 @@ data ScheduledTime
|
||||||
type Hour = Int
|
type Hour = Int
|
||||||
type Minute = Int
|
type Minute = Int
|
||||||
|
|
||||||
{- Next time a Schedule should take effect. The NextTimeWindow is used
|
-- | Next time a Schedule should take effect. The NextTimeWindow is used
|
||||||
- when a Schedule is allowed to start at some point within the window. -}
|
-- when a Schedule is allowed to start at some point within the window.
|
||||||
data NextTime
|
data NextTime
|
||||||
= NextTimeExactly LocalTime
|
= NextTimeExactly LocalTime
|
||||||
| NextTimeWindow LocalTime LocalTime
|
| NextTimeWindow LocalTime LocalTime
|
||||||
|
@ -75,10 +85,10 @@ nextTime schedule lasttime = do
|
||||||
tz <- getTimeZone now
|
tz <- getTimeZone now
|
||||||
return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
|
return $ calcNextTime schedule lasttime $ utcToLocalTime tz now
|
||||||
|
|
||||||
{- Calculate the next time that fits a Schedule, based on the
|
-- | Calculate the next time that fits a Schedule, based on the
|
||||||
- last time it occurred, and the current time. -}
|
-- last time it occurred, and the current time.
|
||||||
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
|
calcNextTime :: Schedule -> Maybe LocalTime -> LocalTime -> Maybe NextTime
|
||||||
calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime
|
calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
| scheduledtime == AnyTime = do
|
| scheduledtime == AnyTime = do
|
||||||
next <- findfromtoday True
|
next <- findfromtoday True
|
||||||
return $ case next of
|
return $ case next of
|
||||||
|
@ -89,10 +99,10 @@ calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
findfromtoday anytime = findfrom recurrance afterday today
|
findfromtoday anytime = findfrom recurrance afterday today
|
||||||
where
|
where
|
||||||
today = localDay currenttime
|
today = localDay currenttime
|
||||||
afterday = sameaslastday || toolatetoday
|
afterday = sameaslastrun || toolatetoday
|
||||||
toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
|
toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime
|
||||||
sameaslastday = lastday == Just today
|
sameaslastrun = lastrun == Just today
|
||||||
lastday = localDay <$> lasttime
|
lastrun = localDay <$> lasttime
|
||||||
nexttime = case scheduledtime of
|
nexttime = case scheduledtime of
|
||||||
AnyTime -> TimeOfDay 0 0 0
|
AnyTime -> TimeOfDay 0 0 0
|
||||||
SpecificTime h m -> TimeOfDay h m 0
|
SpecificTime h m -> TimeOfDay h m 0
|
||||||
|
@ -100,68 +110,84 @@ calcNextTime (Schedule recurrance scheduledtime) lasttime currenttime
|
||||||
window startd endd = NextTimeWindow
|
window startd endd = NextTimeWindow
|
||||||
(LocalTime startd nexttime)
|
(LocalTime startd nexttime)
|
||||||
(LocalTime endd (TimeOfDay 23 59 0))
|
(LocalTime endd (TimeOfDay 23 59 0))
|
||||||
findfrom r afterday day = case r of
|
findfrom r afterday candidate
|
||||||
|
| ynum candidate > (ynum (localDay currenttime)) + 100 =
|
||||||
|
-- avoid possible infinite recusion
|
||||||
|
error $ "bug: calcNextTime did not find a time within 100 years to run " ++
|
||||||
|
show (schedule, lasttime, currenttime)
|
||||||
|
| otherwise = findfromChecked r afterday candidate
|
||||||
|
findfromChecked r afterday candidate = case r of
|
||||||
Daily
|
Daily
|
||||||
| afterday -> Just $ exactly $ addDays 1 day
|
| afterday -> Just $ exactly $ addDays 1 candidate
|
||||||
| otherwise -> Just $ exactly day
|
| otherwise -> Just $ exactly candidate
|
||||||
Weekly Nothing
|
Weekly Nothing
|
||||||
| afterday -> skip 1
|
| afterday -> skip 1
|
||||||
| otherwise -> case (wday <$> lastday, wday day) of
|
| otherwise -> case (wday <$> lastrun, wday candidate) of
|
||||||
(Nothing, _) -> Just $ window day (addDays 6 day)
|
(Nothing, _) -> Just $ window candidate (addDays 6 candidate)
|
||||||
(Just old, curr)
|
(Just old, curr)
|
||||||
| old == curr -> Just $ window day (addDays 6 day)
|
| old == curr -> Just $ window candidate (addDays 6 candidate)
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Monthly Nothing
|
Monthly Nothing
|
||||||
| afterday -> skip 1
|
| afterday -> skip 1
|
||||||
| maybe True (\old -> mnum day > mday old && mday day >= (mday old `mod` minmday)) lastday ->
|
| maybe True (candidate `oneMonthPast`) lastrun ->
|
||||||
-- Window only covers current month,
|
Just $ window candidate (endOfMonth candidate)
|
||||||
-- in case there is a Divisible requirement.
|
|
||||||
Just $ window day (endOfMonth day)
|
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Yearly Nothing
|
Yearly Nothing
|
||||||
| afterday -> skip 1
|
| afterday -> skip 1
|
||||||
| maybe True (\old -> ynum day > ynum old && yday day >= (yday old `mod` minyday)) lastday ->
|
| maybe True (candidate `oneYearPast`) lastrun ->
|
||||||
Just $ window day (endOfYear day)
|
Just $ window candidate (endOfYear candidate)
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Weekly (Just w)
|
Weekly (Just w)
|
||||||
| w < 0 || w > maxwday -> Nothing
|
| w < 0 || w > maxwday -> Nothing
|
||||||
| w == wday day -> if afterday
|
| w == wday candidate -> if afterday
|
||||||
then Just $ exactly $ addDays 7 day
|
then Just $ exactly $ addDays 7 candidate
|
||||||
else Just $ exactly day
|
else Just $ exactly candidate
|
||||||
| otherwise -> Just $ exactly $
|
| otherwise -> Just $ exactly $
|
||||||
addDays (fromIntegral $ (w - wday day) `mod` 7) day
|
addDays (fromIntegral $ (w - wday candidate) `mod` 7) candidate
|
||||||
Monthly (Just m)
|
Monthly (Just m)
|
||||||
| m < 0 || m > maxmday -> Nothing
|
| m < 0 || m > maxmday -> Nothing
|
||||||
-- TODO can be done more efficiently than recursing
|
-- TODO can be done more efficiently than recursing
|
||||||
| m == mday day -> if afterday
|
| m == mday candidate -> if afterday
|
||||||
then skip 1
|
then skip 1
|
||||||
else Just $ exactly day
|
else Just $ exactly candidate
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Yearly (Just y)
|
Yearly (Just y)
|
||||||
| y < 0 || y > maxyday -> Nothing
|
| y < 0 || y > maxyday -> Nothing
|
||||||
| y == yday day -> if afterday
|
| y == yday candidate -> if afterday
|
||||||
then skip 365
|
then skip 365
|
||||||
else Just $ exactly day
|
else Just $ exactly candidate
|
||||||
| otherwise -> skip 1
|
| otherwise -> skip 1
|
||||||
Divisible n r'@Daily -> handlediv n r' yday (Just maxyday)
|
Divisible n r'@Daily -> handlediv n r' yday (Just maxyday)
|
||||||
Divisible n r'@(Weekly _) -> handlediv n r' wnum (Just maxwnum)
|
Divisible n r'@(Weekly _) -> handlediv n r' wnum (Just maxwnum)
|
||||||
Divisible n r'@(Monthly _) -> handlediv n r' mnum (Just maxmnum)
|
Divisible n r'@(Monthly _) -> handlediv n r' mnum (Just maxmnum)
|
||||||
Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing
|
Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing
|
||||||
Divisible _ r'@(Divisible _ _) -> findfrom r' afterday day
|
Divisible _ r'@(Divisible _ _) -> findfrom r' afterday candidate
|
||||||
where
|
where
|
||||||
skip n = findfrom r False (addDays n day)
|
skip n = findfrom r False (addDays n candidate)
|
||||||
handlediv n r' getval mmax
|
handlediv n r' getval mmax
|
||||||
| n > 0 && maybe True (n <=) mmax =
|
| n > 0 && maybe True (n <=) mmax =
|
||||||
findfromwhere r' (divisible n . getval) afterday day
|
findfromwhere r' (divisible n . getval) afterday candidate
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
findfromwhere r p afterday day
|
findfromwhere r p afterday candidate
|
||||||
| maybe True (p . getday) next = next
|
| maybe True (p . getday) next = next
|
||||||
| otherwise = maybe Nothing (findfromwhere r p True . getday) next
|
| otherwise = maybe Nothing (findfromwhere r p True . getday) next
|
||||||
where
|
where
|
||||||
next = findfrom r afterday day
|
next = findfrom r afterday candidate
|
||||||
getday = localDay . startTime
|
getday = localDay . startTime
|
||||||
divisible n v = v `rem` n == 0
|
divisible n v = v `rem` n == 0
|
||||||
|
|
||||||
|
-- Check if the new Day occurs one month or more past the old Day.
|
||||||
|
oneMonthPast :: Day -> Day -> Bool
|
||||||
|
new `oneMonthPast` old = fromGregorian y (m+1) d <= new
|
||||||
|
where
|
||||||
|
(y,m,d) = toGregorian old
|
||||||
|
|
||||||
|
-- Check if the new Day occurs one year or more past the old Day.
|
||||||
|
oneYearPast :: Day -> Day -> Bool
|
||||||
|
new `oneYearPast` old = fromGregorian (y+1) m d <= new
|
||||||
|
where
|
||||||
|
(y,m,d) = toGregorian old
|
||||||
|
|
||||||
endOfMonth :: Day -> Day
|
endOfMonth :: Day -> Day
|
||||||
endOfMonth day =
|
endOfMonth day =
|
||||||
let (y,m,_d) = toGregorian day
|
let (y,m,_d) = toGregorian day
|
||||||
|
@ -186,17 +212,13 @@ yday = snd . toOrdinalDate
|
||||||
ynum :: Day -> Int
|
ynum :: Day -> Int
|
||||||
ynum = fromIntegral . fst . toOrdinalDate
|
ynum = fromIntegral . fst . toOrdinalDate
|
||||||
|
|
||||||
{- Calendar max and mins. -}
|
-- Calendar max values.
|
||||||
maxyday :: Int
|
maxyday :: Int
|
||||||
maxyday = 366 -- with leap days
|
maxyday = 366 -- with leap days
|
||||||
minyday :: Int
|
|
||||||
minyday = 365
|
|
||||||
maxwnum :: Int
|
maxwnum :: Int
|
||||||
maxwnum = 53 -- some years have more than 52
|
maxwnum = 53 -- some years have more than 52
|
||||||
maxmday :: Int
|
maxmday :: Int
|
||||||
maxmday = 31
|
maxmday = 31
|
||||||
minmday :: Int
|
|
||||||
minmday = 28
|
|
||||||
maxmnum :: Int
|
maxmnum :: Int
|
||||||
maxmnum = 12
|
maxmnum = 12
|
||||||
maxwday :: Int
|
maxwday :: Int
|
||||||
|
@ -348,3 +370,27 @@ instance Arbitrary Recurrance where
|
||||||
|
|
||||||
prop_schedule_roundtrips :: Schedule -> Bool
|
prop_schedule_roundtrips :: Schedule -> Bool
|
||||||
prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s
|
prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s
|
||||||
|
|
||||||
|
prop_past_sane :: Bool
|
||||||
|
prop_past_sane = and
|
||||||
|
[ all (checksout oneMonthPast) (mplus1 ++ yplus1)
|
||||||
|
, all (not . (checksout oneMonthPast)) (map swap (mplus1 ++ yplus1))
|
||||||
|
, all (checksout oneYearPast) yplus1
|
||||||
|
, all (not . (checksout oneYearPast)) (map swap yplus1)
|
||||||
|
]
|
||||||
|
where
|
||||||
|
mplus1 = -- new date old date, 1+ months before it
|
||||||
|
[ (fromGregorian 2014 01 15, fromGregorian 2013 12 15)
|
||||||
|
, (fromGregorian 2014 01 15, fromGregorian 2013 02 15)
|
||||||
|
, (fromGregorian 2014 02 15, fromGregorian 2013 01 15)
|
||||||
|
, (fromGregorian 2014 03 01, fromGregorian 2013 01 15)
|
||||||
|
, (fromGregorian 2014 03 01, fromGregorian 2013 12 15)
|
||||||
|
, (fromGregorian 2015 01 01, fromGregorian 2010 01 01)
|
||||||
|
]
|
||||||
|
yplus1 = -- new date old date, 1+ years before it
|
||||||
|
[ (fromGregorian 2014 01 15, fromGregorian 2012 01 16)
|
||||||
|
, (fromGregorian 2014 01 15, fromGregorian 2013 01 14)
|
||||||
|
, (fromGregorian 2022 12 31, fromGregorian 2000 01 01)
|
||||||
|
]
|
||||||
|
checksout cmp (new, old) = new `cmp` old
|
||||||
|
swap (a,b) = (b,a)
|
||||||
|
|
29
debian/changelog
vendored
29
debian/changelog
vendored
|
@ -1,7 +1,5 @@
|
||||||
git-annex (5.20140406) UNRELEASED; urgency=medium
|
git-annex (5.20140413) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
* importfeed: Filename template can now contain an itempubdate variable.
|
|
||||||
Needs feed 0.3.9.2.
|
|
||||||
* assistant: Now detects immediately when other repositories push
|
* assistant: Now detects immediately when other repositories push
|
||||||
changes to a ssh remote, and pulls.
|
changes to a ssh remote, and pulls.
|
||||||
XMPP is no longer needed in this configuration!
|
XMPP is no longer needed in this configuration!
|
||||||
|
@ -10,8 +8,31 @@ git-annex (5.20140406) UNRELEASED; urgency=medium
|
||||||
it's currently connected with.
|
it's currently connected with.
|
||||||
* webapp: Rework xmpp nudge to prompt for either xmpp or a ssh remote be
|
* webapp: Rework xmpp nudge to prompt for either xmpp or a ssh remote be
|
||||||
set up.
|
set up.
|
||||||
|
* Improve handling on monthly/yearly scheduling.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Mon, 07 Apr 2014 16:22:02 -0400
|
-- Joey Hess <joeyh@debian.org> Fri, 11 Apr 2014 21:33:35 -0400
|
||||||
|
|
||||||
|
git-annex (5.20140412) unstable; urgency=high
|
||||||
|
|
||||||
|
* Last release didn't quite fix the high cpu issue in all cases, this should.
|
||||||
|
|
||||||
|
-- Joey Hess <joeyh@debian.org> Fri, 11 Apr 2014 17:14:38 -0400
|
||||||
|
|
||||||
|
git-annex (5.20140411) unstable; urgency=high
|
||||||
|
|
||||||
|
* importfeed: Filename template can now contain an itempubdate variable.
|
||||||
|
Needs feed 0.3.9.2.
|
||||||
|
* Fix rsync progress parsing in locales that use comma in number display.
|
||||||
|
Closes: #744148
|
||||||
|
* assistant: Fix high CPU usage triggered when a monthly fsck is scheduled,
|
||||||
|
and the last time the job ran was a day of the month > 12. This caused a
|
||||||
|
runaway loop. Thanks to Anarcat for his assistance, and to Maximiliano
|
||||||
|
Curia for identifying the cause of this bug.
|
||||||
|
* Remove wget from OSX dmg, due to issues with cert paths that broke
|
||||||
|
git-annex automatic upgrading. Instead, curl is used, unless the
|
||||||
|
OSX system has wget installed, which will then be used.
|
||||||
|
|
||||||
|
-- Joey Hess <joeyh@debian.org> Fri, 11 Apr 2014 14:59:49 -0400
|
||||||
|
|
||||||
git-annex (5.20140405) unstable; urgency=medium
|
git-annex (5.20140405) unstable; urgency=medium
|
||||||
|
|
||||||
|
|
BIN
doc/assistant/connection.png
Normal file
BIN
doc/assistant/connection.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 3.1 KiB |
|
@ -1,3 +1,14 @@
|
||||||
|
## version 5.20140411
|
||||||
|
|
||||||
|
This release fixes a bug that could cause the assistant to use a *lot* of
|
||||||
|
CPU, when monthly fscking was set up.
|
||||||
|
|
||||||
|
Automatic upgrading was broken on OSX for previous versions. This has been
|
||||||
|
fixed, but you'll need to manually upgrade to this version to get it going
|
||||||
|
again. (Note that the fix is currently only available in the daily builds,
|
||||||
|
not a released version.) Workaround: Remove the wget bundled inside the
|
||||||
|
git-annex dmg.
|
||||||
|
|
||||||
## version 5.20140221
|
## version 5.20140221
|
||||||
|
|
||||||
The Windows port of the assistant and webapp is now considered to be beta
|
The Windows port of the assistant and webapp is now considered to be beta
|
||||||
|
|
44
doc/bugs/Drop_--from_always_trusts_local_repository.mdwn
Normal file
44
doc/bugs/Drop_--from_always_trusts_local_repository.mdwn
Normal file
|
@ -0,0 +1,44 @@
|
||||||
|
### Please describe the problem.
|
||||||
|
|
||||||
|
The command `git annex drop --from` always trusts the local repository, even if
|
||||||
|
it is marked as untrusted.
|
||||||
|
|
||||||
|
|
||||||
|
### What steps will reproduce the problem?
|
||||||
|
[[!format sh """
|
||||||
|
mkdir t u; cd t; git init; git commit --allow-empty -m "Initial commit"; git annex init "Trusted"; date > file; git annex add file; git commit -m "Add file"; cd ../u; git init; git remote add t ../t; git fetch t; git merge t/master; git annex init "Untrusted"; git annex untrust .; git annex get file; cd ../t; git remote add u ../u; git fetch u; cd ..
|
||||||
|
"""]]
|
||||||
|
|
||||||
|
Create two repositories, *t* (trusted) and *u* (untrusted). A file is in both
|
||||||
|
repositories. When performing `git annex drop file` in repository *t*, `git
|
||||||
|
annex` will abort because there are not enough copies. But when performing `git
|
||||||
|
annex drop --from t file` in *u*, git annex will delete the copy.
|
||||||
|
|
||||||
|
|
||||||
|
### What version of git-annex are you using? On what operating system?
|
||||||
|
|
||||||
|
Bug was introduced with 6c31e3a8 and still exists in current master (d955cfe7).
|
||||||
|
|
||||||
|
|
||||||
|
### Please provide any additional information below.
|
||||||
|
|
||||||
|
The following change seems to solve the problem. (First time working with
|
||||||
|
Haskell, please excuse the crude code.)
|
||||||
|
|
||||||
|
[[!format diff """
|
||||||
|
diff --git a/Command/Drop.hs b/Command/Drop.hs
|
||||||
|
index 269c4c2..09ea99a 100644
|
||||||
|
--- a/Command/Drop.hs
|
||||||
|
+++ b/Command/Drop.hs
|
||||||
|
@@ -82,8 +82,9 @@ performRemote key afile numcopies remote = lockContent key $ do
|
||||||
|
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
|
||||||
|
present <- inAnnex key
|
||||||
|
u <- getUUID
|
||||||
|
+ level <- lookupTrust u
|
||||||
|
let have = filter (/= uuid) $
|
||||||
|
- if present then u:trusteduuids else trusteduuids
|
||||||
|
+ if present && level <= SemiTrusted then u:trusteduuids else trusteduuids
|
||||||
|
untrusteduuids <- trustGet UnTrusted
|
||||||
|
let tocheck = filter (/= remote) $
|
||||||
|
Remote.remotesWithoutUUID remotes (have++untrusteduuids)
|
||||||
|
"""]]
|
|
@ -520,3 +520,10 @@ $ ps -O start xf | grep git-annex
|
||||||
13761 23:56:38 Z ? 00:00:00 \_ [git] <defunct>
|
13761 23:56:38 Z ? 00:00:00 \_ [git] <defunct>
|
||||||
6252 12:56:59 S ? 00:01:09 /usr/bin/emacs23
|
6252 12:56:59 S ? 00:01:09 /usr/bin/emacs23
|
||||||
"""]]
|
"""]]
|
||||||
|
|
||||||
|
#### This bug is fixed
|
||||||
|
|
||||||
|
> [[fixed|done]]. This was a Cronner bug, triggered when you had a
|
||||||
|
> scheduled fsck job that runs monthly at any time, and the last time it ran was on a day of a
|
||||||
|
> month > 12. Workaround: Disable scheduled fsck jobs, or change them to
|
||||||
|
> run on a specific day of the month. Or upgrade. --[[Joey]]
|
||||||
|
|
|
@ -0,0 +1,12 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="http://joeyh.name/"
|
||||||
|
ip="209.250.56.191"
|
||||||
|
subject="comment 23"
|
||||||
|
date="2014-04-11T16:32:47Z"
|
||||||
|
content="""
|
||||||
|
<maxy> the clock_gettime(0x2 and clock_gettime(0x3 are consistent with getCurrentTime and getTimeZone of nextTime
|
||||||
|
|
||||||
|
So, that strongly points to the Cronner thread, and I doubt this is specific to stable at all.
|
||||||
|
|
||||||
|
Please run git-annex vicfg, and paste all the \"schedule\" lines, from a repository that has the problem. That should allow me to reproduce and fix this bug.
|
||||||
|
"""]]
|
|
@ -0,0 +1,34 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="ayutheos"
|
||||||
|
ip="49.124.177.13"
|
||||||
|
subject="comment 2"
|
||||||
|
date="2014-04-10T07:52:36Z"
|
||||||
|
content="""
|
||||||
|
I'm getting this error too.
|
||||||
|
|
||||||
|
user@NOTEBOOK /d/pictures
|
||||||
|
$ git annex init \"photos\"
|
||||||
|
init photos
|
||||||
|
Detected a filesystem without fifo support.
|
||||||
|
|
||||||
|
Disabling ssh connection caching.
|
||||||
|
|
||||||
|
Detected a crippled filesystem.
|
||||||
|
|
||||||
|
Enabling direct mode.
|
||||||
|
fatal: index file open failed: Invalid argument
|
||||||
|
git-annex: git [Param \"checkout\",Param \"-q\",Param \"-B\",Param \"annex/direct/master\"] failed
|
||||||
|
|
||||||
|
git-annex version:
|
||||||
|
|
||||||
|
user@NOTEBOOK /d/pictures
|
||||||
|
$ git annex version
|
||||||
|
git-annex version: 5.20140403-gdfa17fc
|
||||||
|
build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV DNS Feeds Quvi TDFA CryptoHash
|
||||||
|
key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL
|
||||||
|
remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external
|
||||||
|
local repository version: 5
|
||||||
|
supported repository version: 5
|
||||||
|
upgrade supported from repository versions: 2 3 4
|
||||||
|
|
||||||
|
"""]]
|
|
@ -0,0 +1,11 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="EvanDeaubl"
|
||||||
|
ip="24.251.129.149"
|
||||||
|
subject="comment 5"
|
||||||
|
date="2014-04-09T03:28:24Z"
|
||||||
|
content="""
|
||||||
|
I'm afraid I abandoned this patch. It worked, but was still fidgety for being able to ignore parts of the tree. I found another way to do what I wanted by loading an indirect repo into /data and taking advantage of a surprise side effect in how the /sdcard filesystem translated the symlinks from the ext4 filesystem.
|
||||||
|
|
||||||
|
I can probably scare it up from my archives, but it hasn't been kept up to date. The good news is (as I recall) the patch was pretty small.
|
||||||
|
|
||||||
|
"""]]
|
15
doc/contribute.mdwn
Normal file
15
doc/contribute.mdwn
Normal file
|
@ -0,0 +1,15 @@
|
||||||
|
Help make git-annex better!
|
||||||
|
|
||||||
|
* This website is a wiki, so you can edit and improve any page.
|
||||||
|
* Write a [[new_tip|tips]] explaining how to accomplish something with
|
||||||
|
git-annex.
|
||||||
|
* [[download]] the source code and send patches!
|
||||||
|
* If you know Haskell, git-annex has lots of Haskell code that
|
||||||
|
could be improved. See the [[coding_style]] and have at it.
|
||||||
|
* If you don't know Haskell, git-annex has many other coding opportunities.
|
||||||
|
You could work to improve the Android port (Java etc) or improve the
|
||||||
|
Javascript and CSS of the git-annex webapp, or work on porting libraries
|
||||||
|
needed by the Windows port.
|
||||||
|
|
||||||
|
To send patches, either include the patch in a bug report (small patch)
|
||||||
|
or put up a branch in a git repository containing your changes.
|
|
@ -11,7 +11,7 @@ Now in the
|
||||||
* Month 5 user-driven features and polishing
|
* Month 5 user-driven features and polishing
|
||||||
* Month 6 get Windows out of beta, [[!traillink design/metadata text="metadata and views"]]
|
* Month 6 get Windows out of beta, [[!traillink design/metadata text="metadata and views"]]
|
||||||
* Month 7 user-driven features and polishing
|
* Month 7 user-driven features and polishing
|
||||||
* **Month 8 [[!traillink assistant/telehash]]**
|
* **Month 8 [[!traillink git-remote-daemon]] [[!traillink assistant/telehash]]**
|
||||||
* Month 9 [[!traillink assistant/gpgkeys]] [[!traillink assistant/sshpassword]]
|
* Month 9 [[!traillink assistant/gpgkeys]] [[!traillink assistant/sshpassword]]
|
||||||
* Month 10 get [[assistant/Android]] out of beta
|
* Month 10 get [[assistant/Android]] out of beta
|
||||||
* Month 11 [[!traillink assistant/chunks]] [[!traillink assistant/deltas]]
|
* Month 11 [[!traillink assistant/chunks]] [[!traillink assistant/deltas]]
|
||||||
|
|
15
doc/devblog/day_149__remote_control_working.mdwn
Normal file
15
doc/devblog/day_149__remote_control_working.mdwn
Normal file
|
@ -0,0 +1,15 @@
|
||||||
|
[[design/git-remote-daemon]] is tied into the assistant, and working!
|
||||||
|
Since it's not really ready yet, this is in the `remotecontrol` branch.
|
||||||
|
|
||||||
|
My test case for this is two client repositories, both running
|
||||||
|
the assistant. Both have a bare git repository, accessed over ssh,
|
||||||
|
set up as their only remote, and no other way to keep in touch with
|
||||||
|
one-another. When I change a file in one repository,
|
||||||
|
the other one instantly notices the change and syncs.
|
||||||
|
|
||||||
|
This is gonna be *awesome*. Much less need for XMPP. Windows will be fully
|
||||||
|
usable even without XMPP. Also, most of the work I did today will be fully
|
||||||
|
reused when the telehash backend gets built. The telehash-c developer is
|
||||||
|
making noises about it being almost ready for use, too!
|
||||||
|
|
||||||
|
Today's work was sponsored by Frédéric Schütz.
|
16
doc/devblog/day_149__signal.mdwn
Normal file
16
doc/devblog/day_149__signal.mdwn
Normal file
|
@ -0,0 +1,16 @@
|
||||||
|
[[!meta title="day 150 signal"]]
|
||||||
|
|
||||||
|
The git-remote-daemon now robustly handles loss of signal, with
|
||||||
|
reconnection backoffs. And it detects if the remote ssh server has a too
|
||||||
|
old version of git-annex-shell and the webapp will display a warning
|
||||||
|
message.
|
||||||
|
|
||||||
|
[[!img /assistant/connection.png]]
|
||||||
|
|
||||||
|
Also, made the webapp show a network signal bars icon next to both
|
||||||
|
ssh and xmpp remotes that it's currently connected with. And, updated the
|
||||||
|
webapp's nudging to set up XMPP to now suggest either an XMPP or a ssh remote.
|
||||||
|
|
||||||
|
I think that the `remotecontrol` branch is nearly ready for merging!
|
||||||
|
|
||||||
|
Today's work was sponsored by Paul Tagliamonte.
|
18
doc/devblog/day_151__birthday_bug.mdwn
Normal file
18
doc/devblog/day_151__birthday_bug.mdwn
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
Pushed out a new release today, fixing two important bugs, followed by a
|
||||||
|
second release which fixed the bugs harder.
|
||||||
|
|
||||||
|
Automatic upgrading was broken on OSX. The webapp will tell you upgrading
|
||||||
|
failed, and you'll need to manually download the .dmg and install it.
|
||||||
|
|
||||||
|
With help from Maximiliano Curia, finally tracked down a bug I have been
|
||||||
|
chasing for a while where the assistant would start using a lot of CPU
|
||||||
|
while not seeming to be busy doing anything. Turned out to be triggered by
|
||||||
|
a scheduled fsck that was configured to run once a month with no particular
|
||||||
|
day specified.
|
||||||
|
|
||||||
|
That bug turned out to affect users who first scheduled such a fsck job
|
||||||
|
after the 11th day of the month. So I expedited putting a release out to
|
||||||
|
avoid anyone else running into it starting tomorrow.
|
||||||
|
|
||||||
|
(Oddly, the 11th day of this month also happens to be my birthday. I did not
|
||||||
|
expect to have to cut 2 releases today..)
|
|
@ -0,0 +1,10 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="augusto"
|
||||||
|
ip="177.98.104.136"
|
||||||
|
subject="comment 3"
|
||||||
|
date="2014-04-08T22:46:18Z"
|
||||||
|
content="""
|
||||||
|
When I saw Sharebox's page on Github I had the impression it was vaporware. It has a section named \"Planned Interface\" and there are no updates for quite a while.
|
||||||
|
|
||||||
|
Is it working? How to install/use it?
|
||||||
|
"""]]
|
1
doc/forum/Walkthrough_for_direct_mode__63__.mdwn
Normal file
1
doc/forum/Walkthrough_for_direct_mode__63__.mdwn
Normal file
|
@ -0,0 +1 @@
|
||||||
|
Hello Joey, I would be very much interested in a walkthrough for direct mode, as detailed as the one currently published. I see the comments in the current walkthrough on some differences to direct mode, but to me it is not obvious what best practices for git-annex use would be in direct mode, with and without the assistant. For a mix of Linux, OS X and Windows installations in the homes, it may also be interesting to see how to best set up the individual machines. Many thanks -
|
|
@ -0,0 +1 @@
|
||||||
|
Here's one thing I don't fully understand yet. If I add a remote repository, like an archive repository on Box—or if I want to change a transfer repository to an archive repository—do I need to add it or change it separately on each of my computers? Or just one?
|
|
@ -67,7 +67,7 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
|
||||||
|
|
||||||
* notifychanges
|
* notifychanges
|
||||||
|
|
||||||
This is used by `git-annex remote-daemon` to be notified when
|
This is used by `git-annex remotedaemon` to be notified when
|
||||||
refs in the remote repository are changed.
|
refs in the remote repository are changed.
|
||||||
|
|
||||||
* gcryptsetup gcryptid
|
* gcryptsetup gcryptid
|
||||||
|
@ -106,6 +106,9 @@ changed.
|
||||||
|
|
||||||
If set, disallows any command that could modify the repository.
|
If set, disallows any command that could modify the repository.
|
||||||
|
|
||||||
|
Note that this does not prevent passing commands on to git-shell.
|
||||||
|
For that, you also need ...
|
||||||
|
|
||||||
* GIT_ANNEX_SHELL_LIMITED
|
* GIT_ANNEX_SHELL_LIMITED
|
||||||
|
|
||||||
If set, disallows running git-shell to handle unknown commands.
|
If set, disallows running git-shell to handle unknown commands.
|
||||||
|
|
|
@ -39,7 +39,8 @@ files with git.
|
||||||
|
|
||||||
----
|
----
|
||||||
|
|
||||||
git-annex is [[Free Software|license]]
|
git-annex is [[Free Software|license]], written in [Haskell](http://www.haskell.org/).
|
||||||
|
You can [[contribute]]!
|
||||||
|
|
||||||
git-annex's wiki is powered by [Ikiwiki](http://ikiwiki.info/) and
|
git-annex's wiki is powered by [Ikiwiki](http://ikiwiki.info/) and
|
||||||
hosted by [Branchable](http://branchable.com/).
|
hosted by [Branchable](http://branchable.com/).
|
||||||
|
|
|
@ -1,32 +0,0 @@
|
||||||
git-annex 5.20140227 released with [[!toggle text="these changes"]]
|
|
||||||
[[!toggleable text="""
|
|
||||||
* metadata: Field names limited to alphanumerics and a few whitelisted
|
|
||||||
punctuation characters to avoid issues with views, etc.
|
|
||||||
* metadata: Field names are now case insensative.
|
|
||||||
* 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: 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.
|
|
||||||
* Add build dep on regex-compat to fix build on mipsel, which lacks
|
|
||||||
regex-tdfa.
|
|
||||||
* Disable test suite on sparc, which is missing optparse-applicative.
|
|
||||||
* Put non-object tmp files in .git/annex/misctmp, leaving .git/annex/tmp
|
|
||||||
for only partially transferred objects."""]]
|
|
|
@ -1,34 +0,0 @@
|
||||||
git-annex 5.20140306 released with [[!toggle text="these changes"]]
|
|
||||||
[[!toggleable text="""
|
|
||||||
* sync: Fix bug in direct mode that caused a file that was not
|
|
||||||
checked into git to be deleted when there was a conflicting
|
|
||||||
merge with a remote.
|
|
||||||
* webapp: Now supports HTTPS.
|
|
||||||
* webapp: No longer supports a port specified after --listen, since
|
|
||||||
it was buggy, and that use case is better supported by setting up HTTPS.
|
|
||||||
* annex.listen can be configured, instead of using --listen
|
|
||||||
* annex.startupscan can be set to false to disable the assistant's startup
|
|
||||||
scan.
|
|
||||||
* Probe for quvi version at run time.
|
|
||||||
* webapp: Filter out from Switch Repository list any
|
|
||||||
repositories listed in autostart file that don't have a
|
|
||||||
git directory anymore. (Or are bare)
|
|
||||||
* webapp: Refuse to start in a bare git repository.
|
|
||||||
* assistant --autostart: Refuse to start in a bare git repository.
|
|
||||||
* webapp: Don't list the public repository group when editing a
|
|
||||||
git repository; it only makes sense for special remotes.
|
|
||||||
* view, vfilter: Add support for filtering tags and values out of a view,
|
|
||||||
using !tag and field!=value.
|
|
||||||
* vadd: Allow listing multiple desired values for a field.
|
|
||||||
* view: Refuse to enter a view when no branch is currently checked out.
|
|
||||||
* metadata: To only set a field when it's not already got a value, use
|
|
||||||
-s field?=value
|
|
||||||
* Run .git/hooks/pre-commit-annex whenever a commit is made.
|
|
||||||
* sync: Automatically resolve merge conflict between and annexed file
|
|
||||||
and a regular git file.
|
|
||||||
* glacier: Pass --region to glacier checkpresent.
|
|
||||||
* webdav: When built with a new enough haskell DAV (0.6), disable
|
|
||||||
the http response timeout, which was only 5 seconds.
|
|
||||||
* webapp: Include no-pty in ssh authorized\_keys lines.
|
|
||||||
* assistant: Smarter log file rotation, which takes free disk space
|
|
||||||
into account."""]]
|
|
13
doc/news/version_5.20140411.mdwn
Normal file
13
doc/news/version_5.20140411.mdwn
Normal file
|
@ -0,0 +1,13 @@
|
||||||
|
git-annex 5.20140411 released with [[!toggle text="these changes"]]
|
||||||
|
[[!toggleable text="""
|
||||||
|
* importfeed: Filename template can now contain an itempubdate variable.
|
||||||
|
Needs feed 0.3.9.2.
|
||||||
|
* Fix rsync progress parsing in locales that use comma in number display.
|
||||||
|
Closes: #[744148](http://bugs.debian.org/744148)
|
||||||
|
* assistant: Fix high CPU usage triggered when a monthly fsck is scheduled,
|
||||||
|
and the last time the job ran was a day of the month > 12. This caused a
|
||||||
|
runaway loop. Thanks to Anarcat for his assistance, and to Maximiliano
|
||||||
|
Curia for identifying the cause of this bug.
|
||||||
|
* Remove wget from OSX dmg, due to issues with cert paths that broke
|
||||||
|
git-annex automatic upgrading. Instead, curl is used, unless the
|
||||||
|
OSX system has wget installed, which will then be used."""]]
|
3
doc/news/version_5.20140412.mdwn
Normal file
3
doc/news/version_5.20140412.mdwn
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
git-annex 5.20140412 released with [[!toggle text="these changes"]]
|
||||||
|
[[!toggleable text="""
|
||||||
|
* Last release didn't quite fix the high cpu issue in all cases, this should."""]]
|
|
@ -0,0 +1,23 @@
|
||||||
|
[[!comment format=mdwn
|
||||||
|
username="https://www.google.com/accounts/o8/id?id=AItOawl64jV2rE8GMogJ6XuqESSkz78RVBgVdGw"
|
||||||
|
nickname="Mesut"
|
||||||
|
subject="I can't add google drive as remote"
|
||||||
|
date="2014-04-10T07:55:56Z"
|
||||||
|
content="""
|
||||||
|
Hi,
|
||||||
|
|
||||||
|
I am new to git-annex and I want to use google drive as remote but I can't.
|
||||||
|
|
||||||
|
I create syslink to `googledriveannex` in `/usr/local/bin`.
|
||||||
|
|
||||||
|
When I execute below command, command waiting but not make anything:
|
||||||
|
|
||||||
|
`$ git annex initremote googledrive type=external externaltype=googledrive encryption=shared folder=gitannex`
|
||||||
|
|
||||||
|
`initremote googledrive (encryption setup)` # Waiting but does not do anything.
|
||||||
|
|
||||||
|
What I am doing wrong?
|
||||||
|
|
||||||
|
Thanks for helps
|
||||||
|
|
||||||
|
"""]]
|
|
@ -3,8 +3,6 @@ manager. Here's how to add git-annex support to gitolite, so you can
|
||||||
`git annex copy` files to a gitolite repository, and `git annex get`
|
`git annex copy` files to a gitolite repository, and `git annex get`
|
||||||
files from it.
|
files from it.
|
||||||
|
|
||||||
Warning : The method described here works with gitolite version g2, avaible in the g2 branch on github. There is an experimental support for g3 in the git-annex branch, if you tested it please add some feedback.
|
|
||||||
|
|
||||||
A nice feature of using gitolite with git-annex is that users can be given
|
A nice feature of using gitolite with git-annex is that users can be given
|
||||||
read-only access to a repository, and this allows them to `git annex get`
|
read-only access to a repository, and this allows them to `git annex get`
|
||||||
file contents, but not change anything.
|
file contents, but not change anything.
|
||||||
|
@ -12,7 +10,8 @@ file contents, but not change anything.
|
||||||
First, you need new enough versions:
|
First, you need new enough versions:
|
||||||
|
|
||||||
* gitolite 2.2 is needed -- this version contains a git-annex-shell ADC
|
* gitolite 2.2 is needed -- this version contains a git-annex-shell ADC
|
||||||
and supports "ua" ADCs.
|
and supports "ua" ADCs. Alternatively, gitoline g3 also recently added
|
||||||
|
support for git-annex.
|
||||||
* git-annex 3.20111016 or newer needs to be installed on the gitolite
|
* git-annex 3.20111016 or newer needs to be installed on the gitolite
|
||||||
server. Don't install an older version, it wouldn't be secure!
|
server. Don't install an older version, it wouldn't be secure!
|
||||||
|
|
||||||
|
@ -39,6 +38,13 @@ cd /usr/local/lib/gitolite/adc/ua/
|
||||||
cp gitolite/contrib/adc/git-annex-shell .
|
cp gitolite/contrib/adc/git-annex-shell .
|
||||||
</pre>
|
</pre>
|
||||||
|
|
||||||
|
If using gitolite g3, an additional setup step is needed:
|
||||||
|
In the ENABLE list in the rc file, add an entry like this:
|
||||||
|
|
||||||
|
<pre>
|
||||||
|
'git-annex-shell ua',
|
||||||
|
</pre>
|
||||||
|
|
||||||
Now all gitolite repositories can be used with git-annex just as any
|
Now all gitolite repositories can be used with git-annex just as any
|
||||||
ssh remote normally would be used. For example:
|
ssh remote normally would be used. For example:
|
||||||
|
|
||||||
|
|
1
doc/todo/LIst_of_Available_Remotes_in_Webapp.mdwn
Normal file
1
doc/todo/LIst_of_Available_Remotes_in_Webapp.mdwn
Normal file
|
@ -0,0 +1 @@
|
||||||
|
When using git-annex in a distributed fashion (lots of repos everywhere) It is easy to lose track of which remotes has a particular repo and enable it. Currently I have to run `git annex info` and see which remotes are available then add them through the webapp. Would it be possible to make webapp show all repos not just the ones it is syncing give an option to enable it.
|
1
doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn
Normal file
1
doc/todo/Time_Stamping_of_Events_in_Webapp.mdwn
Normal file
|
@ -0,0 +1 @@
|
||||||
|
Currently events happening in the webapp (sync upload etc. on the right) has no time stamp thus user has no way to tell when was the last sync happened. Which is problematic when not using XMPP and repos lag behind.
|
|
@ -1,5 +1,5 @@
|
||||||
Name: git-annex
|
Name: git-annex
|
||||||
Version: 5.20140405
|
Version: 5.20140412
|
||||||
Cabal-Version: >= 1.8
|
Cabal-Version: >= 1.8
|
||||||
License: GPL-3
|
License: GPL-3
|
||||||
Maintainer: Joey Hess <joey@kitenet.net>
|
Maintainer: Joey Hess <joey@kitenet.net>
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue