Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fix/misc (#134)

Browse Source 
* use latest version of dependency for metadata if best version is unsatisfied

* cleanup

* add config setting to allow protections around package uploads to specific registries

* change to whitelist

* properly parse whitelist

* enable deleting deprecated admin users
This commit is contained in:
Lucy C
2023-04-12 15:39:59 -06:00
committed by GitHub
parent 35500cfc02
commit c3dab78718
8 changed files with 59 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
config/settings.yml
View File

@@ -39,6 +39,7 @@ marketplace-name: "_env:MARKETPLACE_NAME:CHANGE ME"
max-eos-version: "_env:MAX_VERSION:0.3.4.0"
min-eos-version: "_env:MIN_VERSION:0.3.4.0"
run-migration: "_env:RUN_MIGRATION:false"
whitelist: "_env:WHITELIST:ADD ME"
database:
database: "_env:PG_DATABASE:start9_registry"

6
src/Database/Queries.hs
View File

@@ -19,7 +19,7 @@ import Model (
Metric (Metric),
PkgDependency (..),
PkgRecord (PkgRecord),
VersionRecord (VersionRecord), VersionPlatform (VersionPlatform), EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch),
VersionRecord (VersionRecord), VersionPlatform (VersionPlatform), EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch), PkgRecordId,
)
import Orphans.Emver ()
import Startlude (
@@ -286,14 +286,14 @@ fetchAppVersion :: MonadIO m => PkgId -> Version -> ReaderT SqlBackend m (Maybe
fetchAppVersion pkgId version = get (VersionRecordKey (PkgRecordKey pkgId) version)
fetchLatestApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe (P.Entity PkgRecord, P.Entity VersionRecord))
fetchLatestApp :: MonadIO m => PkgRecordId -> ReaderT SqlBackend m (Maybe (P.Entity PkgRecord, P.Entity VersionRecord))
fetchLatestApp appId = fmap headMay . sortResults . select $ do
(service :& version) <-
from $
table @PkgRecord
`innerJoin` table @VersionRecord
`on` (\(service :& version) -> service ^. PkgRecordId ==. version ^. VersionRecordPkgId)
where_ (service ^. PkgRecordId ==. val (PkgRecordKey appId))
where_ (service ^. PkgRecordId ==. val appId)
pure (service, version)
where
sortResults = fmap $ sortOn (Down . versionRecordNumber . entityVal . snd)

11
src/Foundation.hs
View File

@@ -114,7 +114,7 @@ import Lib.PkgRepository (
import Lib.Types.Core (PkgId, S9PK)
import Model (
Admin (..),
Key (AdminKey),
Key (AdminKey), EntityField (AdminId, AdminDeletedAt),
)
import Settings (AppSettings (appShouldLogAll))
import System.Console.ANSI.Codes (
@@ -150,6 +150,9 @@ import Yesod.Persist.Core (
YesodPersistRunner (..),
defaultGetDBRunner,
)
import Database.Persist ((==.))
import Database.Persist (selectFirst)
import Database.Persist (entityVal)
-- | The foundation datatype for your application. This can be a good place to
@@ -312,9 +315,11 @@ instance YesodAuth RegistryCtx where
pool <- getsYesod appConnPool
let checkCreds k s = flip runSqlPool pool $ do
let passHash = hashWith SHA256 . encodeUtf8 . ("start9_admin:" <>) $ decodeUtf8 s
get (AdminKey $ decodeUtf8 k) <&> \case
selectFirst [AdminDeletedAt ==. Nothing, AdminId ==. (AdminKey $ decodeUtf8 k)] [] <&> \case
Nothing -> False
Just Admin{adminPassHash} -> adminPassHash == passHash
Just adminEntity -> do
let Admin{adminPassHash} = entityVal adminEntity
adminPassHash == passHash
defaultMaybeBasicAuthId checkCreds defaultAuthSettings
loginDest _ = PackageIndexR V1

33
src/Handler/Admin.hs
View File

@@ -144,11 +144,13 @@ import Yesod (
import Yesod.Auth (YesodAuth (maybeAuthId))
import Yesod.Core.Types (JSONResponse (JSONResponse))
import Database.Persist.Sql (runSqlPool)
import Data.List (elem)
postPkgUploadR :: Handler ()
postPkgUploadR = do
resourcesTemp <- getsYesod $ (</> "temp") . resourcesDir . appSettings
whitelist <- getsYesod $ whitelist . appSettings
createDirectoryIfMissing True resourcesTemp
withTempDirectory resourcesTemp "newpkg" $ \dir -> do
let path = dir </> "temp" <.> "s9pk"
@@ -159,22 +161,25 @@ postPkgUploadR = do
when (isNothing res) $ do
$logError "Failed to extract package"
sendResponseText status500 "Failed to extract package"
PackageManifest{..} <-
PackageManifest{..} <- do
liftIO (decodeFileStrict (dir </> "manifest.json"))
`orThrow` sendResponseText status500 "Failed to parse manifest.json"
renameFile path (dir </> (toS . unPkgId) packageManifestId <.> "s9pk")
let targetPath = pkgRepoFileRoot </> show packageManifestId </> show packageManifestVersion
removePathForcibly targetPath
createDirectoryIfMissing True targetPath
renameDirectory dir targetPath
maybeAuthId >>= \case
Nothing -> do
$logError
"The Impossible has happened, an unauthenticated user has managed to upload a pacakge to this registry"
pure ()
Just name -> do
now <- liftIO getCurrentTime
runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now)
if (not $ elem packageManifestId whitelist)
then sendResponseText status500 "Package does not belong on this registry."
else do
renameFile path (dir </> (toS . unPkgId) packageManifestId <.> "s9pk")
let targetPath = pkgRepoFileRoot </> show packageManifestId </> show packageManifestVersion
removePathForcibly targetPath
createDirectoryIfMissing True targetPath
renameDirectory dir targetPath
maybeAuthId >>= \case
Nothing -> do
$logError
"The Impossible has happened, an unauthenticated user has managed to upload a pacakge to this registry"
pure ()
Just name -> do
now <- liftIO getCurrentTime
runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now)
where
retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m)

14
src/Handler/Package/V1/Index.hs
View File

@@ -51,7 +51,6 @@ import Startlude (
Show,
Text,
Traversable (traverse),
catMaybes,
const,
encodeUtf8,
filter,
@@ -90,6 +89,7 @@ import Yesod (
import Data.Tuple (fst)
import Database.Persist.Postgresql (entityVal)
import Yesod.Core (getsYesod)
import Data.List (head)
data PackageReq = PackageReq
{ packageReqId :: !PkgId
@@ -187,7 +187,7 @@ getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, p
let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo'
pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo)
let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions
let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo
let depMetadata = zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo
lift $
fmap HM.fromList $
for depMetadata $ \(depId, title, v, isLocal) -> do
@@ -244,13 +244,17 @@ selectLatestVersionFromSpec pkgRanges vs =
-- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package)
selectDependencyBestVersion :: (PkgDependency, PkgRecord) -> [VersionRecord] -> Maybe (PkgId, Text, Version, Bool)
selectDependencyBestVersion :: (PkgDependency, PkgRecord) -> [VersionRecord] -> (PkgId, Text, Version, Bool)
selectDependencyBestVersion pkgDepInfo depVersions = do
let pkgDepRecord = fst pkgDepInfo
let isLocal = pkgRecordHidden $ snd pkgDepInfo
let depId = pkgDependencyDepId pkgDepRecord
let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord
let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions
let pkgId = unPkgRecordKey depId
case maximumOn versionRecordNumber satisfactory of
Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal)
Nothing -> Nothing
Just bestVersion -> (pkgId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal)
-- use latest version of dep for metadata info
Nothing -> do
let latestDepVersion = head $ sortOn (Down . versionRecordNumber) depVersions
(pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)

2
src/Handler/Util.hs
View File

@@ -25,7 +25,7 @@ import Lib.PkgRepository (
)
import Lib.Types.Core (PkgId, OsArch)
import Lib.Types.Emver (
Version (Version, unVersion),
Version,
VersionRange,
satisfies, parseVersion
)

1
src/Model.hs
View File

@@ -148,6 +148,7 @@ Admin
Id Text
createdAt UTCTime
passHash (Digest SHA256)
deletedAt UTCTime Maybe
Upload
uploader AdminId

23
src/Settings.hs
View File

@@ -17,7 +17,7 @@ import Startlude ( ($)
, ByteString
, ConvertText(toS)
, FilePath
, IsString(fromString)
, Monad(return)
, Monoid(mempty)
, Text
@@ -56,6 +56,10 @@ import Lib.PkgRepository ( EosRepo(EosRepo, eosRepoFileRo
)
import Lib.Types.Emver ( Version )
import Orphans.Emver ( )
import Lib.Types.Core (PkgId)
import Data.String
import Data.List.Extra (splitOn)
import Prelude (map, read)
-- | Runtime settings to configure this application. These settings can be
-- loaded from various sources: defaults, environment variables, config files,
-- theoretically even a database.
@@ -75,12 +79,12 @@ data AppSettings = AppSettings
-- ^ Should all log messages be displayed?
, errorLogRoot :: !FilePath
, marketplaceName :: !Text
, maxOsVersion :: !Version
, minOsVersion :: !Version
, maxOsVersion :: !Version
, minOsVersion :: !Version
, registryHostname :: !Text
, registryVersion :: !Version
, resourcesDir :: !FilePath
, needsMigration :: !Bool
, needsMigration :: !Bool
, sslAuto :: !Bool
, sslCertLocation :: !FilePath
, sslCsrLocation :: !FilePath
@@ -88,6 +92,7 @@ data AppSettings = AppSettings
, sslPath :: !FilePath
, staticBinDir :: !FilePath
, torPort :: !AppPort
, whitelist :: ![PkgId]
}
instance Has PkgRepo AppSettings where
extract = liftA2 PkgRepo ((</> "apps") . resourcesDir) staticBinDir
@@ -111,8 +116,8 @@ instance FromJSON AppSettings where
appShouldLogAll <- o .:? "should-log-all" .!= False
errorLogRoot <- o .: "error-log-root"
marketplaceName <- o .: "marketplace-name"
maxOsVersion <- o .: "max-eos-version"
minOsVersion <- o .: "min-eos-version"
maxOsVersion <- o .: "max-eos-version"
minOsVersion <- o .: "min-eos-version"
registryHostname <- o .: "registry-hostname"
resourcesDir <- o .: "resources-path"
needsMigration <- o .: "run-migration"
@@ -120,6 +125,7 @@ instance FromJSON AppSettings where
sslPath <- o .: "ssl-path"
staticBinDir <- o .: "static-bin-dir"
torPort <- o .: "tor-port"
whitelist <- parseCommaSeparatedList <$> o .:? "whitelist" .!= []
let sslKeyLocation = sslPath </> "key.pem"
let sslCsrLocation = sslPath </> "certificate.csr"
@@ -141,3 +147,8 @@ compileTimeAppSettings :: AppSettings
compileTimeAppSettings = case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
Error e -> panic $ toS e
Success settings -> settings
parseCommaSeparatedList :: String -> [PkgId]
parseCommaSeparatedList input = do
let strings = splitOn "," input
map read strings