diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 829e15f1f6..ef2a5d8536 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -183,7 +183,7 @@ updateTo' pairs = do else return $ "merging " ++ unwords (map Git.Ref.describe branches) ++ " into " ++ fromRef name - localtransitions <- parseTransitionsStrictly "local" . decodeBL + localtransitions <- parseTransitionsStrictly "local" <$> getLocal transitionsLog unless (null tomerge) $ do showSideAction merge_desc @@ -524,7 +524,7 @@ handleTransitions jl localts refs = do return True where getreftransition ref = do - ts <- parseTransitionsStrictly "remote" . decodeBL + ts <- parseTransitionsStrictly "remote" <$> catFile ref transitionsLog return (ref, ts) @@ -560,7 +560,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do | neednewlocalbranch && null transitionedrefs = "new branch for transition " ++ tdesc | otherwise = "continuing transition " ++ tdesc tdesc = show $ map describeTransition tlist - tlist = transitionList ts + tlist = knownTransitionList ts {- The changes to make to the branch are calculated and applied to - the branch directly, rather than going through the journal, diff --git a/CHANGELOG b/CHANGELOG index 66bc49485d..7e898d3834 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -23,7 +23,7 @@ git-annex (7.20181212) UNRELEASED; urgency=medium of remotes would appear missing when used with this version of git-annex. * Improve uuid.log parser to preserve whitespace in repo descriptions. - * Improve activity.log parser to not remove unknown activities, + * Improve activity.log parser to not remove unknown values, allowing for future expansion. -- Joey Hess Tue, 18 Dec 2018 12:24:52 -0400 diff --git a/COPYRIGHT b/COPYRIGHT index 69af6f5a12..16626892bd 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -81,38 +81,6 @@ License: MIT-twitter OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -Files: Logs/Line.hs -Copyright: 2001, The University Court of the University of Glasgow. -License: ghc-license - All rights reserved. - . - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions are met: - . - - Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - . - - Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - . - - Neither name of the University nor the names of its contributors may be - used to endorse or promote products derived from this software without - specific prior written permission. - . - THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF - GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, - INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND - FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE - UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE - FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY - OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH - DAMAGE. - License: GPL-3+ The full text of version 3 of the GPL is distributed as doc/license/GPL in this package's source, or in /usr/share/common-licenses/GPL-3 on diff --git a/Logs/Line.hs b/Logs/Line.hs index 716ee8be87..3bacc29027 100644 --- a/Logs/Line.hs +++ b/Logs/Line.hs @@ -1,38 +1,9 @@ -{- - -The Glasgow Haskell Compiler License - -Copyright 2001, The University Court of the University of Glasgow. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -- Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -- Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -- Neither name of the University nor the names of its contributors may be -used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF -GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. - --} +{- line based log files + - + - Copyright 2019 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} module Logs.Line where @@ -42,20 +13,6 @@ import qualified Data.Attoparsec.ByteString.Lazy as A import Data.Attoparsec.ByteString.Char8 (isEndOfLine) import qualified Data.DList as D --- This is the same as Data.List.lines, with \r added. --- This works around some versions of git-annex which wrote \r --- into git-annex branch files on Windows. Those \r's sometimes --- accumulated over time, so a single line could end with multiple \r's --- before the \n. -splitLines :: String -> [String] -splitLines "" = [] -splitLines s = cons (case break (\c -> c == '\n' || c == '\r') s of - (l, s') -> (l, case s' of - [] -> [] - _:s'' -> splitLines s'')) - where - cons ~(h, t) = h : t - {- Applies a parser to each line of a log file. - - If the parser fails to parse a line, that line is skipped, instead of diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs index d44bfd75b6..550727451d 100644 --- a/Logs/Transitions.hs +++ b/Logs/Transitions.hs @@ -7,7 +7,7 @@ - done that is listed in the remote branch by checking that the local - branch contains the same transition, with the same or newer start time. - - - Copyright 2013 Joey Hess + - Copyright 2013-2019 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -19,7 +19,12 @@ import Annex.VectorClock import Logs.Line import qualified Data.Set as S +import Data.Either +import Data.ByteString (ByteString) +import Data.ByteString.Builder import qualified Data.ByteString.Lazy as L +import qualified Data.Attoparsec.ByteString.Lazy as A +import qualified Data.Attoparsec.ByteString.Char8 as A8 transitionsLog :: FilePath transitionsLog = "transitions.log" @@ -31,7 +36,8 @@ data Transition data TransitionLine = TransitionLine { transitionStarted :: VectorClock - , transition :: Transition + -- New transitions that we don't know about yet are preserved. + , transition :: Either ByteString Transition } deriving (Ord, Eq) type Transitions = S.Set TransitionLine @@ -44,44 +50,50 @@ noTransitions :: Transitions noTransitions = S.empty addTransition :: VectorClock -> Transition -> Transitions -> Transitions -addTransition c t = S.insert $ TransitionLine c t +addTransition c t = S.insert $ TransitionLine c (Right t) -showTransitions :: Transitions -> String -showTransitions = unlines . map showTransitionLine . S.elems - -{- If the log contains new transitions we don't support, returns Nothing. -} -parseTransitions :: String -> Maybe Transitions -parseTransitions = check . map parseTransitionLine . splitLines +buildTransitions :: Transitions -> Builder +buildTransitions = mconcat . map genline . S.elems where - check l - | all isJust l = Just $ S.fromList $ catMaybes l - | otherwise = Nothing + genline tl = buildt (transition tl) <> charUtf8 ' ' + <> buildVectorClock (transitionStarted tl) <> charUtf8 '\n' + buildt (Left b) = byteString b + buildt (Right t) = byteString (encodeBS (show t)) -parseTransitionsStrictly :: String -> String -> Transitions -parseTransitionsStrictly source = fromMaybe badsource . parseTransitions - where - badsource = giveup $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!" +parseTransitions :: L.ByteString -> Transitions +parseTransitions = fromMaybe S.empty . A.maybeResult . A.parse + (S.fromList <$> parseLogLines transitionLineParser) + +parseTransitionsStrictly :: String -> L.ByteString -> Transitions +parseTransitionsStrictly source b = + let ts = parseTransitions b + in if S.null $ S.filter (isLeft . transition) ts + then ts + else giveup $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!" showTransitionLine :: TransitionLine -> String showTransitionLine (TransitionLine c t) = unwords [show t, formatVectorClock c] -parseTransitionLine :: String -> Maybe TransitionLine -parseTransitionLine s = TransitionLine - <$> parseVectorClock cs - <*> readish ts +transitionLineParser :: A.Parser TransitionLine +transitionLineParser = do + t <- (parsetransition <$> A.takeByteString) + _ <- A8.char ' ' + c <- vectorClockParser + return $ TransitionLine c t where - ws = words s - ts = Prelude.head ws - cs = unwords $ Prelude.tail ws + parsetransition b = case readish (decodeBS b) of + Just t -> Right t + Nothing -> Left b combineTransitions :: [Transitions] -> Transitions combineTransitions = S.unions -transitionList :: Transitions -> [Transition] -transitionList = nub . map transition . S.elems +{- Unknown types of transitions are omitted. -} +knownTransitionList :: Transitions -> [Transition] +knownTransitionList = nub . rights . map transition . S.elems {- Typically ran with Annex.Branch.change, but we can't import Annex.Branch - here since it depends on this module. -} -recordTransitions :: (FilePath -> (L.ByteString -> L.ByteString) -> Annex ()) -> Transitions -> Annex () +recordTransitions :: (FilePath -> (L.ByteString -> Builder) -> Annex ()) -> Transitions -> Annex () recordTransitions changer t = changer transitionsLog $ - encodeBL . showTransitions . S.union t . parseTransitionsStrictly "local" . decodeBL + buildTransitions . S.union t . parseTransitionsStrictly "local"