Skip to content

Commit

Permalink
Avoid incrementing the timestamp/snapshot version
Browse files Browse the repository at this point in the history 
(unnecessarily, at least). The DB state now has enough information to recreate
the TUF files at any one point. We take advantage of this to make sure that if
the TUF cache is updating itself, we only increment the timestamp/snapshot
version if something actually changed, or the existing files are older than 1
hour.

The cabal tests (including backup roundtrips) now pass! Yay! \o/
  • Loading branch information
@edsko
edsko committed Jan 6, 2016
1 parent 74325b0 commit 9886ce5
Show file tree
Hide file tree
Showing 3 changed files with 228 additions and 95 deletions.
129 changes: 110 additions & 19 deletions Distribution/Server/Features/Security/Backup.hs
View file
Expand Up @@ -7,13 +7,15 @@ module Distribution.Server.Features.Security.Backup (
-- stdlib
import Control.Monad.State
import Data.Maybe (fromMaybe)
import Data.Version
import Text.CSV
import Data.Time
import Data.Version (Version(..), showVersion)
import Text.CSV hiding (csv)

-- hackage
import Distribution.Server.Features.Security.FileInfo
import Distribution.Server.Features.Security.State
import Distribution.Server.Framework.BackupDump
import Distribution.Server.Framework.BackupRestore
import Distribution.Server.Features.Security.State

-- hackage-security
import Hackage.Security.Util.Some
Expand All @@ -29,36 +31,72 @@ import qualified Hackage.Security.Server as Sec
securityBackup :: SecurityState -> [BackupEntry]
securityBackup = (:[]) . csvToBackup ["partialstate.csv"] . exportSecurityState

-- | Export the security state to CSV
--
-- Version 0.2 introduced more information into this format:
--
-- > "0.2"
-- > "version" , "timestamp" , <timestamp version>
-- > "version" , "snapshot" , <snapshot version>
-- > "update" , "time" , <time of last update>
-- > "update" , "info" , "root" , <file length> , <SHA256>
-- > "update" , "info" , "mirrors" , <file length> , <SHA256>
-- > "update" , "info" , "tarGz" , <file length> , <SHA256>
-- > "update" , "info" , "tar" , <file length> , <SHA256>
--
-- Version 0.1 was prior to the introduction of 'TUFUpdate' and looked like:
--
-- > "0.1"
-- > "role" , "file-version"
-- > "timestamp" , <timestamp version>
-- > "snapshot" , <snapshot version>
exportSecurityState :: SecurityState -> CSV
exportSecurityState SecurityState{..} = [
[showVersion versionCSVVer]
, versionCSVKey
, ["timestamp", show securityTimestampVersion]
, ["snapshot", show securitySnapshotVersion]
]
, ["version", "timestamp", show securityTimestampVersion]
, ["version", "snapshot", show securitySnapshotVersion]
] ++ case securityLastUpdate of
Nothing -> []
Just TUFUpdate{..} -> [
["update", "time", formatUTCTime tufUpdateTime]
, fileInfoCSV "root" tufUpdateInfoRoot
, fileInfoCSV "mirrors" tufUpdateInfoMirrors
, fileInfoCSV "tarGz" tufUpdateInfoTarGz
, fileInfoCSV "tar" tufUpdateInfoTar
]
where
versionCSVVer = Version [0,1] []
versionCSVKey = [ "role"
, "file-version"
]
versionCSVVer = Version [0,2] []

fileInfoCSV file FileInfo{..} =
["update", "info", file, show fileInfoLength, show fileInfoSHA256]

{-------------------------------------------------------------------------------
Restore
-------------------------------------------------------------------------------}

data PartialState = PartialSecurityState {
partialTimestampVersion :: Maybe Sec.FileVersion
, partialSnapshotVersion :: Maybe Sec.FileVersion
partialTimestampVersion :: Maybe Sec.FileVersion
, partialSnapshotVersion :: Maybe Sec.FileVersion
, partialUpdateTime :: Maybe UTCTime
, partialUpdateInfoRoot :: Maybe FileInfo
, partialUpdateInfoMirrors :: Maybe FileInfo
, partialUpdateInfoTarGz :: Maybe FileInfo
, partialUpdateInfoTar :: Maybe FileInfo
}

securityRestore :: Some Sec.Key -> Some Sec.Key -> RestoreBackup SecurityState
securityRestore securityTimestampKey
securitySnapshotKey
=
aux PartialSecurityState {
partialTimestampVersion = Nothing
, partialSnapshotVersion = Nothing
}
partialTimestampVersion = Nothing
, partialSnapshotVersion = Nothing
, partialUpdateTime = Nothing
, partialUpdateInfoRoot = Nothing
, partialUpdateInfoMirrors = Nothing
, partialUpdateInfoTarGz = Nothing
, partialUpdateInfoTar = Nothing
}
where
aux :: PartialState -> RestoreBackup SecurityState
aux st = RestoreBackup {
Expand All @@ -71,7 +109,15 @@ securityRestore securityTimestampKey
return SecurityState{
securityTimestampVersion = fromMaybe reset partialTimestampVersion
, securitySnapshotVersion = fromMaybe reset partialSnapshotVersion
, securityLastUpdate = Nothing
, securityLastUpdate = do
-- We can construct the last update only if we have all fields
-- Otherwise, we have to return 'Nothing'
tufUpdateTime <- partialUpdateTime
tufUpdateInfoRoot <- partialUpdateInfoRoot
tufUpdateInfoMirrors <- partialUpdateInfoMirrors
tufUpdateInfoTarGz <- partialUpdateInfoTarGz
tufUpdateInfoTar <- partialUpdateInfoTar
return TUFUpdate{..}
, ..
}

Expand All @@ -89,8 +135,53 @@ securityRestore securityTimestampKey
return $ aux st

importSecurityState :: PartialState -> CSV -> Restore PartialState
importSecurityState =
\st -> (`execStateT` st) . mapM fromRecord . drop 2
importSecurityState st ([version]:csv) =
byVersion =<< parseVersion "CSV version header" version
where
byVersion :: Version -> Restore PartialState
byVersion (Version [0,1] []) = execStateT (import_v0 csv) st
byVersion (Version [0,2] []) = execStateT (import_v1 csv) st
byVersion _otherversion = fail "Unsupported version"
importSecurityState _ _ = fail "Unrecognized CSV format"

import_v1 :: CSV -> StateT PartialState Restore ()
import_v1 = mapM_ fromRecord
where
fromRecord :: Record -> StateT PartialState Restore ()
fromRecord ["version", "timestamp", strTimestampVersion] = do
version <- parseRead "timestamp version" strTimestampVersion
modify $ \st -> st { partialTimestampVersion = Just version }
fromRecord ["version", "snapshot", strSnapshotVersion] = do
version <- parseRead "snapshot version" strSnapshotVersion
modify $ \st -> st { partialSnapshotVersion = Just version }
fromRecord ["update", "time", strUpdateTime] = do
updateTime <- parseUTCTime "last update time" strUpdateTime
modify $ \st -> st { partialUpdateTime = Just updateTime }
fromRecord ("update":"info":"root":sec) = do
info <- fromInfoRecord sec
modify $ \st -> st { partialUpdateInfoRoot = Just info }
fromRecord ("update":"info":"mirrors":sec) = do
info <- fromInfoRecord sec
modify $ \st -> st { partialUpdateInfoMirrors = Just info }
fromRecord ("update":"info":"tarGz":sec) = do
info <- fromInfoRecord sec
modify $ \st -> st { partialUpdateInfoTarGz = Just info }
fromRecord ("update":"info":"tar":sec) = do
info <- fromInfoRecord sec
modify $ \st -> st { partialUpdateInfoTar = Just info }
fromRecord otherRecord =
fail $ "Unexpected record: " ++ show otherRecord

fromInfoRecord :: Monad m => Record -> m FileInfo
fromInfoRecord [strFileLength, strSHA256] = do
fileInfoLength <- parseRead "file length" strFileLength
fileInfoSHA256 <- parseSHA "file SHA256" strSHA256
return FileInfo{..}
fromInfoRecord otherRecord =
fail $ "Unexpected info record: " ++ show otherRecord

import_v0 :: CSV -> StateT PartialState Restore ()
import_v0 = mapM_ fromRecord . drop 1
where
fromRecord :: Record -> StateT PartialState Restore ()
fromRecord ["timestamp", strTimestampVersion] = do
Expand Down
92 changes: 17 additions & 75 deletions Distribution/Server/Features/Security/Cache.hs
View file
Expand Up @@ -32,7 +32,6 @@ import Distribution.Server.Features.Core
import qualified Distribution.Server.Features.Security.SHA256 as SHA

-- Hackage security
import qualified Hackage.Security.Server as Sec
import qualified Hackage.Security.Util.Path as Sec

{-------------------------------------------------------------------------------
Expand All @@ -53,9 +52,6 @@ import qualified Hackage.Security.Util.Path as Sec
Hence, we all keep these together in the single cache. Note that it _is_
ok to update the index without updating the TUF data, because the index
is append only.
TODO: Compute length, MD5 and SHA256 hashes simultenously when updating
any of these TUF files.
-------------------------------------------------------------------------------}

data SecurityCache = SecurityCache {
Expand All @@ -73,82 +69,28 @@ updateSecurityCache :: StateComponent AcidState SecurityState
-> CoreFeature
-> IO SecurityCache
updateSecurityCache securityState securityFileCache coreFeature = do
now <- getCurrentTime
files <- readAsyncCache securityFileCache
snapshot <- computeSnapshot securityState now coreFeature files
timestamp <- computeTimestamp securityState now snapshot
now <- getCurrentTime
SecurityFileCache{..} <- readAsyncCache securityFileCache
IndexTarballInfo{..} <- queryGetIndexTarballInfo coreFeature

let maxAge = 60 * 60 -- Don't update cache if unchanged and younger than 1hr
tufUpdate = TUFUpdate{
tufUpdateTime = now
, tufUpdateInfoRoot = fileInfo securityFileCacheRoot
, tufUpdateInfoMirrors = fileInfo securityFileCacheMirrors
, tufUpdateInfoTarGz = fileInfo indexTarballIncremGz
, tufUpdateInfoTar = fileInfo indexTarballIncremUn
}

(timestamp, snapshot) <- updateState securityState $
UpdateSecurityState maxAge tufUpdate

return SecurityCache {
securityCacheTimestamp = timestamp
, securityCacheSnapshot = snapshot
, securityCacheRoot = securityFileCacheRoot files
, securityCacheMirrors = securityFileCacheMirrors files
}

-- | Compute new snapshot
computeSnapshot :: StateComponent AcidState SecurityState
-> UTCTime
-> CoreFeature
-> SecurityFileCache
-> IO Snapshot
computeSnapshot securityState now coreFeature SecurityFileCache{..} = do
indexTarballInfo <- queryGetIndexTarballInfo coreFeature
snapshotVersion <- updateState securityState NextSnapshotVersion
snapshotKey <- queryState securityState GetSnapshotKey
let rootInfo = secFileInfo securityFileCacheRoot
mirrorsInfo = secFileInfo securityFileCacheMirrors
tarGzInfo = secFileInfo $ indexTarballIncremGz indexTarballInfo
tarInfo = secFileInfo $ indexTarballIncremUn indexTarballInfo
snapshot = Sec.Snapshot {
Sec.snapshotVersion = snapshotVersion
, Sec.snapshotExpires = Sec.expiresInDays now 3
, Sec.snapshotInfoRoot = rootInfo
, Sec.snapshotInfoMirrors = mirrorsInfo
, Sec.snapshotInfoTarGz = tarGzInfo
, Sec.snapshotInfoTar = Just tarInfo
}
signed = Sec.withSignatures layout [snapshotKey] snapshot
raw = Sec.renderJSON layout signed
md5 = Crypto.hash raw
sha256 = SHA.sha256 raw
return $ Snapshot TUFFile {
_tufFileContent = raw
, _tufFileLength = fromIntegral $ BS.Lazy.length raw
, _tufFileHashMD5 = md5
, _tufFileHashSHA256 = sha256
, _tufFileModified = now
, securityCacheRoot = securityFileCacheRoot
, securityCacheMirrors = securityFileCacheMirrors
}
where
layout = Sec.hackageRepoLayout

-- | Compute new timestamp
computeTimestamp :: StateComponent AcidState SecurityState
-> UTCTime
-> Snapshot
-> IO Timestamp
computeTimestamp securityState now snapshot = do
timestampVersion <- updateState securityState NextTimestampVersion
timestampKey <- queryState securityState GetTimestampKey
let timestamp = Sec.Timestamp {
timestampVersion = timestampVersion
, timestampExpires = Sec.expiresInDays now 3
, timestampInfoSnapshot = secFileInfo snapshot
}
signed = Sec.withSignatures layout [timestampKey] timestamp
raw = Sec.renderJSON layout signed
md5 = Crypto.hash raw
sha256 = SHA.sha256 raw
-- We don't actually use the SHA256 of the timestamp for anything; we
-- compute it just for uniformity's sake.
return $ Timestamp TUFFile {
_tufFileContent = raw
, _tufFileLength = fromIntegral $ BS.Lazy.length raw
, _tufFileHashMD5 = md5
, _tufFileHashSHA256 = sha256
, _tufFileModified = now
}
where
layout = Sec.hackageRepoLayout

{-------------------------------------------------------------------------------
The security file cache
Expand Down

0 comments on commit 9886ce5

Please sign in to comment.