From c3dab787184234cf017610aa26bb65d2098e0fa6 Mon Sep 17 00:00:00 2001 From: Lucy C <12953208+elvece@users.noreply.github.com> Date: Wed, 12 Apr 2023 15:39:59 -0600 Subject: [PATCH] Fix/misc (#134) * 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 --- config/settings.yml | 1 + src/Database/Queries.hs | 6 +++--- src/Foundation.hs | 11 ++++++++--- src/Handler/Admin.hs | 33 +++++++++++++++++++-------------- src/Handler/Package/V1/Index.hs | 14 +++++++++----- src/Handler/Util.hs | 2 +- src/Model.hs | 1 + src/Settings.hs | 23 +++++++++++++++++------ 8 files changed, 59 insertions(+), 32 deletions(-) diff --git a/config/settings.yml b/config/settings.yml index b90f685..0cdd972 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -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" diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index e5f52ad..8243d87 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -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) diff --git a/src/Foundation.hs b/src/Foundation.hs index a0c12d6..4f54bf2 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -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 diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 0eb4256..070bb3e 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -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) diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs index 8ae8c07..3fa413d 100644 --- a/src/Handler/Package/V1/Index.hs +++ b/src/Handler/Package/V1/Index.hs @@ -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) diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index 6cdf91e..4559c2d 100644 --- a/src/Handler/Util.hs +++ b/src/Handler/Util.hs @@ -25,7 +25,7 @@ import Lib.PkgRepository ( ) import Lib.Types.Core (PkgId, OsArch) import Lib.Types.Emver ( - Version (Version, unVersion), + Version, VersionRange, satisfies, parseVersion ) diff --git a/src/Model.hs b/src/Model.hs index cb8f24c..1160fe4 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -148,6 +148,7 @@ Admin Id Text createdAt UTCTime passHash (Digest SHA256) + deletedAt UTCTime Maybe Upload uploader AdminId diff --git a/src/Settings.hs b/src/Settings.hs index 02bf7e7..2f6ab63 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -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 \ No newline at end of file