aelve/guide
1
1
Fork 0
mirror of https://github.com/aelve/guide.git synced 2024-11-25 18:56:52 +03:00
Code Issues Projects Releases Wiki Activity

Make the smart update, that cuts the end on an archive in case the md5 did not match

Browse Source
This commit is contained in:
Boris M. Yartsev 2017-06-06 01:26:16 +03:00
parent 7112d7321e
commit 86875c1a19
6 changed files with 181 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
REPL/app/Main.hs
View File

@ -13,72 +13,7 @@ import System.Directory(copyFile)
import System.IO (stdout, hFlush)
import qualified Data.Map.Strict as Map
import ArchiveUpdate
import TarUtil
import REPL
{-
updateHackage :: IO()
updateHackage = do
val <- performSmartUpdate archiveFile snapshotURL archiveURL
putStrLn $ "Updated " ++ show val
-- Compares the hackage archive file with the original file
compareArchive :: FilePath -> FilePath -> IO()
compareArchive archive1 archive2= do
val <- compareFiles archive1 archive2
putStrLn $ "Compare result " ++ archive1 ++ " " ++ archive2 ++ " " ++ (show val)
-- Parses the integer value at the end of the string
-- Used to parse commands like "cut 42"
parseIntEnd :: (Num a, Read a) => String -> a
parseIntEnd val | DL.length l > 0 = read (DL.last l)
| otherwise = 0
where l = words val
processCommand :: String -> IO()
processCommand command
| chk "check" = showUpdateData archiveFile snapshotURL -- checks the current gzip archive and understands what to download
| chk "checkclone" = showUpdateData archiveCloneFile snapshotURL -- checks the current gzip archive and understands what to download
| chk "file" = showFileSnapshot archiveFile -- shows the snapshot of hackage file
| chk "fileclone" = showFileSnapshot archiveCloneFile
| chk "copyorig" = copyArchive archiveFile archiveCloneFile -- copies the current archive to the orig place
| chk "cut" = cutFile archiveFile (parseIntEnd command) -- cuts the end of the gzip file for checking purposes
| chk "cutclone" = cutFile archiveCloneFile (parseIntEnd command)
| chk "unzip" = unzipArchive archiveFile tarArchive -- unzips the downloaded gzip archive
| chk "unzipclone" = unzipArchive archiveCloneFile tarArchiveClone -- unzips the downloaded gzip archive
| chk "tarparse" = showMap tarArchive 50 -- loads the tar information in the memory
| chk "tarparseclone" = showMap tarArchiveClone 50 -- loads the tar clone information in the memory
| chk "tarshow" = showTarContents tarArchive
| chk "tarshowclone" = showTarContents tarArchiveClone
| chk "compare" = showArchiveCompare archiveFile archiveCloneFile
| chk "update" = updateHackage -- updates the current gzip archive
| chk "tarcmp" = showDiffMap tarArchive tarArchiveClone
| chk "exit" = exitREPL
| chk "help" = showHelp
| otherwise = showHelp
where pc = map DC.toLower command
chk val = DL.isPrefixOf val pc
processCycle :: IO ()
processCycle = forever $ do
putStr "Input command: "
hFlush stdout
command <- getLine
hFlush stdout
(processCommand command) `X.catch` eh `X.catch` eh2 `X.catch` eh3
where
eh (e :: X.IOException) = putStrLn $ "IO Error: " ++ (show e)
eh2 (e :: UpdateArchiveException) = putStrLn $ "Parsing error: " ++ (show e)
eh3 (e :: X.ErrorCall) = putStrLn $ "Error call: " ++ (show e)
-}
defaultPBI :: ProcessBuilderInfo
defaultPBI = PBI {

5
REPL/index-project.cabal
View File

@ -15,7 +15,7 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: ArchiveUpdate, TarUtil, REPL
exposed-modules: ArchiveUpdate, TarUtil, REPL, Storage
build-depends: base >= 4.7 && < 5
, directory
, containers
@ -31,11 +31,14 @@ library
, pureMD5
, aeson
, text
, mtl
, safecopy
, cereal
, unix
, exceptions
, transformers
, zlib
, acid-state
default-language: Haskell2010

112
REPL/src/ArchiveUpdate.hs
View File

@ -7,12 +7,12 @@ module ArchiveUpdate (
FileSnapshotData,
UpdateArchiveException,
performArchiveFileUpdate,
performArchiveCutUpdate,
getFileSubstring,
calcFileData,
calcUpdateResult2,
truncateIfExists,
unzipFile,
removeIfExists,
compareFiles) where
import Network.HTTP.Client(Request(..), parseUrlThrow, newManager, responseBody, httpLbs)
@ -136,7 +136,7 @@ calcFileData file = do
-- archive. ArchiveIsOk - everything is fine.
-- Update - need to add some information to the end of the file
-- Reload - need to redownload the whole archive completely
data UpdateRange = ArchiveIsOk | Reload Range | Update Range deriving (Eq, Show)
data UpdateRange = ArchiveIsOk | Corrupted | Update Range deriving (Eq, Show)
-- The maximum range to download in one request from the hackage
@ -148,7 +148,7 @@ calcUpdateResult :: HackageSnapshotData -> FileSnapshotData -> UpdateRange
calcUpdateResult hackage file
| hackage == file = ArchiveIsOk -- both are equal
| lenH > lenF = Update (lenF, lenH - 1) -- need to append a bit
| otherwise = Reload (0, lenH - 1) -- delete old file and redownload it
| otherwise = Corrupted -- delete old file and redownload it
where lenH = lengthFile hackage
lenF = lengthFile file
@ -195,6 +195,7 @@ getFileSubstring :: FilePath -> Int64 -> Int64 -> IO BL.ByteString
getFileSubstring file from len = do
c <- BL.readFile file
return $ BL.take len $ BL.drop from c
-- unzips the file to the other file
unzipFile :: FilePath -> FilePath -> IO()
unzipFile from to = do
@ -202,56 +203,44 @@ unzipFile from to = do
fileBody <- (BL.readFile from)
BL.appendFile to (GZip.decompress fileBody)
{-
-- The description of the file, that is used to compare archive on the harddisk
-- with the archive in the hackage. It uses length and md5 hash from the pureMD5
-- library
-- Updates the archive with zip stuff
performSmartUpdate :: FilePath -> URL -> URL -> IO Bool
performSmartUpdate file json archive = do
(range, snapshot, _) <- calcUpdateResult2 file json
case range of
ArchiveIsOk -> do
putStrLn $ "Archive is up to date"
return False
(Update range) -> do
putStrLn $ "Updating the archive"
update range snapshot
return True
(Reload range) -> do
putStrLn $ "Reloading the archive"
removeIfExists file
update range snapshot
return True
where
ranges = cropRanges maxRange
write2File range = do
body <- fetchRangeData archive range
print "Start of range: "
print $ BL.take 100 body
BL.appendFile file body
putStrLn $ "\tAppended chunk " ++ (show range)
update range snapshot = do
mapM_ write2File (ranges range)
newFileData <- calcFileData file
when (newFileData /= snapshot) $ X.throwIO $ UAE $ "Updated archive corrupted"
-}
-- performs the update, returns True if the the archive was modified
performArchiveFileUpdate :: URL -> URL -> FilePath -> IO Bool
performArchiveFileUpdate :: URL -> URL -> FilePath -> IO UpdateRange
performArchiveFileUpdate snapshotURL archiveURL archive = do
(range, snapshot, _) <- calcUpdateResult2 archive snapshotURL
putStrLn "Updating"
putStrLn $ "Snapshot from " ++ snapshotURL ++ " " ++ (show snapshot)
putStrLn $ "Update range " ++ (show range)
case range of
ArchiveIsOk -> (putStrLn $ "Archive is up to date") >> return False
Update range -> do
putStrLn $ "Updating " ++ archive ++ " from " ++ archiveURL
result <- updateArchive archive archiveURL snapshot range
putStrLn $ if result then "Update successfull" else "MD5 does not match"
return True
Reload range -> undefined
putStrLn $ "Updating " ++ archive ++ " from " ++ archiveURL
(status, snapshot, _) <- calcUpdateResult2 archive snapshotURL
case status of
ArchiveIsOk -> (putStrLn $ "Archive is up to date") >> return ArchiveIsOk
_ -> cutUpdate modifFunctions
where
performUpdate = updateArchive archive archiveURL
modifFunctions = [return (), cutting 50000, cutting 500000, cutting 5000000, removing]
cutting val = do
putStrLn $ "\tCutting " ++ (show val) ++ " from " ++ archive
truncateIfExists archive val
removing = do
putStrLn $ "\tRemoving " ++ archive
removeIfExists archive
cutUpdate (mf : mfs) = do
mf
(status, snapshot, _) <- calcUpdateResult2 archive snapshotURL
case status of
ArchiveIsOk -> return ArchiveIsOk
Corrupted -> cutUpdate mfs
Update range -> do
putStrLn $ "\tSnapshot from " ++ snapshotURL ++ " " ++ (show snapshot)
putStrLn $ "\tUpdate range " ++ (show range)
result <- performUpdate snapshot range
if result then return status
else cutUpdate mfs
cutUpdate [] = do
putStrLn "Failed to update"
return Corrupted
updateArchive :: FilePath -> URL -> HackageSnapshotData -> Range -> IO Bool
updateArchive archive archiveURL snapshot range = do
@ -267,7 +256,7 @@ write2File archive url range = do
BL.appendFile archive body
putStrLn "Append ok"
{-
performArchiveCutUpdateF :: (FilePath -> IO Bool) -> FilePath -> Int64 -> IO Bool
performArchiveCutUpdateF updateFunc archive cutSize = do
putStrLn $ "Cutting " ++ (show cutSize) ++ " from " ++ archive ++ " before update"
@ -276,4 +265,25 @@ performArchiveCutUpdateF updateFunc archive cutSize = do
performArchiveCutUpdate :: URL -> URL -> FilePath -> Int64 -> IO Bool
performArchiveCutUpdate snapshotURL archiveURL = performArchiveCutUpdateF (performArchiveFileUpdate snapshotURL archiveURL)
-}
{-
case range of
ArchiveIsOk -> (putStrLn $ "Archive is up to date") >> return ArchiveIsOk
Update range -> do
putStrLn $ "Updating " ++ archive ++ " from " ++ archiveURL
result <- updateArchive archive archiveURL snapshot range
putStrLn $ if result then "Update successfull" else "MD5 does not match"
return ArchiveIsOk
-}
{-
Corrupted -> do
putStrLn $ "Reloading " ++ archive ++ " from " ++ archiveURL
removeIfExists archive
result <- updateArchive archive archiveURL snapshot range
putStrLn $ if result then "Update successfull" else "MD5 does not match"
return True
-}

35
REPL/src/REPL.hs
View File

@ -81,8 +81,8 @@ buildCommand pbi = processCommand
| chk "unzipclone" = unzipArchive (archiveClone pbi) (tarClone pbi) -- unzips the downloaded gzip archive
| chk "unzip" = unzipArchive (archive pbi) (tar pbi) -- unzips the downloaded gzip archive
| chk "cleanclone" = undefined
| chk "clean" = undefined
| chk "cleanclone" = removeArchiveFiles (archiveClone pbi) (tarClone pbi)
| chk "clean" = removeArchiveFiles (archive pbi) (tar pbi)
| chk "tarparsepreclone" = showPreMap (tarClone pbi) 50 -- loads the tar clone information in the memory
| chk "tarparsepre" = showPreMap (tar pbi) 50 -- loads the tar information in the memory
@ -91,10 +91,11 @@ buildCommand pbi = processCommand
| chk "tarparse" = showMap (tar pbi) 50 -- loads the tar information in the memory
| chk "compare" = showArchiveCompare (archive pbi) (archiveClone pbi)
| chk "updatecut" = performArchiveCutUpdate (snapshotURL pbi) (archiveURL pbi)
(archive pbi) (parseIntEnd command) >> return ()
| chk "update" = performArchiveFileUpdate (snapshotURL pbi) (archiveURL pbi) (archive pbi) >> return ()
-- | chk "acidupdate" = undefined
-- | chk "acidquery" = undefined
-- | chk "updatesmart" = undefined
| chk "tarcmp" = showDiffMap (tar pbi) (tarClone pbi)
@ -182,8 +183,8 @@ showHelp pbi = do
putStrLn $ "tarparsepreclone - same for " ++ (tarClone pbi)
putStrLn $ "tarcmp - compares the entries of " ++ (tar pbi) ++ " and " ++ (tarClone pbi)
putStrLn $ "update - updates the current " ++ arch ++ " from " ++ (archiveURL pbi)
putStrLn $ "updatecut size - cuts the size from " ++ arch ++ " and then updates"
putStrLn "exit - exits this repl"
where
arch = archive pbi
archC = archiveClone pbi
@ -193,8 +194,6 @@ showArchiveCompare archive1 archive2= do
val <- compareFiles archive1 archive2
putStrLn $ "Compare result " ++ archive1 ++ " " ++ archive2 ++ " " ++ (show val)
exitREPL :: IO()
exitREPL = putStrLn "Finished working with hackage REPL" >> exitSuccess
@ -210,4 +209,24 @@ unzipArchive archive tar = do
putStrLn $ "Unzipping " ++ archive ++ " to " ++ tar
unzipFile archive tar
removeArchiveFiles :: FilePath -> FilePath -> IO()
removeArchiveFiles archive tar = do
putStrLn $ "Removing archive files " ++ archive ++ " " ++ tar
removeIfExists archive
removeIfExists tar
-- make update of acidic map of the packages
{-
updateAcidicMap :: URL -> URL -> FilePath -> IO()
updateAcidicMap snapU archU arch cutValue =
do acid <- openLocalState (KeyValue Map.empty)
-- update the archive
status <- performArchiveCutUpdate snapU archU arch cutValue
closeAcidState acid
-}
--rebuildIndex :: URL -> URL -> FilePath -> IO ()
--rebuildIndex

85
REPL/src/Storage.hs Normal file
View File

@ -0,0 +1,85 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
-- This is modified example from AcidState
module Storage (
insertKey,
updateMap,
lookupKey,
compareMap) where
import Data.Typeable
import Data.Acid
import Data.Acid.Advanced
import Data.SafeCopy
import Control.Monad.Reader
import qualified Data.Map as M
import qualified Control.Monad.State as State
import TarUtil
import qualified Data.Version as DV
data KeyValue = KeyValue !HackageMap
deriving (Typeable)
type Key = String
type Value = HackagePackage
$(deriveSafeCopy 0 'base ''DV.Version)
$(deriveSafeCopy 0 'base ''HackagePackage)
$(deriveSafeCopy 0 'base ''KeyValue)
insertKey :: Key -> Value -> Update KeyValue ()
insertKey key value = do
KeyValue hackageMap <- State.get
State.put (KeyValue (M.insert key value hackageMap))
updateMap :: HackageMap -> Update KeyValue ()
updateMap newMap = State.put (KeyValue newMap)
lookupKey :: Key -> Query KeyValue (Maybe Value)
lookupKey key = do
KeyValue m <- ask
return (M.lookup key m)
compareMap :: HackageMap -> Query KeyValue HackageUpdateMap
compareMap newMap = do
KeyValue oldMap <- ask
return (buildDifferenceMap oldMap newMap)
$(makeAcidic ''KeyValue ['insertKey, 'lookupKey])
{-
main :: IO ()
main = do acid <- openLocalState (KeyValue Map.empty)
updated <- performArchiveCutUpdate snapU archU arch cutValue
-- load the map from acid
-- update the map from acid
closeAcidState acid
where
pbi = defaultPBI
archU = (archiveURL pbi)
snapU = (snapshotURL pbi)
arch = (archive pbi)
cutValue = 100000
-}
{-
case args of
[key]
-> do mbKey <- query acid (LookupKey key)
case mbKey of
Nothing -> putStrLn $ key ++ " has no associated value."
Just value -> putStrLn $ key ++ " = " ++ value
[key,val]
-> do update acid (InsertKey key val)
putStrLn "Done."
_ -> do putStrLn "Usage:"
putStrLn " key Lookup the value of 'key'."
putStrLn " key value Set the value of 'key' to 'value'."
closeAcidState acid
-}

5
REPL/src/TarUtil.hs
View File

@ -5,7 +5,10 @@ module TarUtil (
buildHackageMap,
buildPreHackageMap,
loadTar,
parsePath
parsePath,
HackagePackage (..),
HackageMap,
HackageUpdateMap
) where
import qualified Codec.Archive.Tar as Tar