mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-19 21:07:37 +03:00
Merge pull request #196 from gren-lang/improve-error-message-for-kernel-pkg-with-unsigned-commit
Improve error message for kernel pkg with unsigned commit
This commit is contained in:
Robin Heggelund Hansen
GitHub
commit
91191fea2b
@ -241,24 +241,27 @@ extractPublicKeyFromCommit git path hash = do
|
||||
Exit.ExitFailure _ -> do
|
||||
return ""
|
||||
Exit.ExitSuccess ->
|
||||
let decodedSignatureChunk =
|
||||
Base64.decode $
|
||||
BSStrict.pack $
|
||||
concatMap (dropWhile (\c -> c == ' ')) $
|
||||
takeWhile (\line -> not $ List.isInfixOf "-----END SSH SIGNATURE-----" line) $
|
||||
drop 1 $
|
||||
dropWhile (\line -> not $ List.isPrefixOf "gpgsig" line) $
|
||||
lines stdout
|
||||
in case decodedSignatureChunk of
|
||||
Left err ->
|
||||
return err
|
||||
Right decoded ->
|
||||
return $
|
||||
BSLazy.unpack $
|
||||
BSBuilder.toLazyByteString $
|
||||
BSBuilder.lazyByteStringHex $
|
||||
Get.runGet decodePublicKeyFromChunk $
|
||||
BSLazy.fromStrict decoded
|
||||
let signatureChunk =
|
||||
concatMap (dropWhile (\c -> c == ' ')) $
|
||||
takeWhile (\line -> not $ List.isInfixOf "-----END SSH SIGNATURE-----" line) $
|
||||
drop 1 $
|
||||
dropWhile (\line -> not $ List.isPrefixOf "gpgsig" line) $
|
||||
lines stdout
|
||||
in if null signatureChunk
|
||||
then return ""
|
||||
else
|
||||
let decodedSignatureChunk =
|
||||
Base64.decode $ BSStrict.pack signatureChunk
|
||||
in case decodedSignatureChunk of
|
||||
Left err ->
|
||||
return err
|
||||
Right decoded ->
|
||||
return $
|
||||
BSLazy.unpack $
|
||||
BSBuilder.toLazyByteString $
|
||||
BSBuilder.lazyByteStringHex $
|
||||
Get.runGet decodePublicKeyFromChunk $
|
||||
BSLazy.fromStrict decoded
|
||||
|
||||
{- Description of format at https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.sshsig
|
||||
Description of byte encoding at https://dl.acm.org/doi/pdf/10.17487/RFC4253
|
||||
|
||||
@ -383,11 +383,15 @@ build key cache depsMVar pkg (Solver.Details vsn maybeLocalPath _) f fs =
|
||||
mapM_ readMVar mvars
|
||||
maybeStatuses <- traverse readMVar =<< readMVar mvar
|
||||
case sequence maybeStatuses of
|
||||
Nothing ->
|
||||
Left CrawlCorruption ->
|
||||
do
|
||||
Reporting.report key Reporting.DBroken
|
||||
return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f
|
||||
Just statuses ->
|
||||
Left CrawlUnsignedKernelCode ->
|
||||
do
|
||||
Reporting.report key Reporting.DBroken
|
||||
return $ Left $ Just $ Exit.BD_UnsignedBuild pkg vsn
|
||||
Right statuses ->
|
||||
do
|
||||
rmvar <- newEmptyMVar
|
||||
rmvars <- traverse (fork . compile platform pkg rmvar) statuses
|
||||
@ -479,7 +483,7 @@ gatherForeignInterfaces directArtifacts =
|
||||
-- CRAWL
|
||||
|
||||
type StatusDict =
|
||||
Map.Map ModuleName.Raw (MVar (Maybe Status))
|
||||
Map.Map ModuleName.Raw (MVar (Either CrawlError Status))
|
||||
|
||||
data Status
|
||||
= SLocal DocsStatus (Map.Map ModuleName.Raw ()) Src.Module
|
||||
@ -487,18 +491,22 @@ data Status
|
||||
| SKernelLocal [Kernel.Chunk]
|
||||
| SKernelForeign
|
||||
|
||||
crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> Bool -> ModuleName.Raw -> IO (Maybe Status)
|
||||
data CrawlError
|
||||
= CrawlUnsignedKernelCode
|
||||
| CrawlCorruption
|
||||
|
||||
crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> Bool -> ModuleName.Raw -> IO (Either CrawlError Status)
|
||||
crawlModule foreignDeps mvar pkg src docsStatus authorizedForKernelCode name =
|
||||
do
|
||||
let path = src </> ModuleName.toFilePath name <.> "gren"
|
||||
exists <- File.exists path
|
||||
case Map.lookup name foreignDeps of
|
||||
Just ForeignAmbiguous ->
|
||||
return Nothing
|
||||
return $ Left CrawlCorruption
|
||||
Just (ForeignSpecific iface) ->
|
||||
if exists
|
||||
then return Nothing
|
||||
else return (Just (SForeign iface))
|
||||
then return $ Left CrawlCorruption
|
||||
else return (Right (SForeign iface))
|
||||
Nothing ->
|
||||
if exists
|
||||
then crawlFile foreignDeps mvar pkg src docsStatus authorizedForKernelCode name path
|
||||
@ -507,10 +515,10 @@ crawlModule foreignDeps mvar pkg src docsStatus authorizedForKernelCode name =
|
||||
then
|
||||
if authorizedForKernelCode
|
||||
then crawlKernel foreignDeps mvar pkg src name
|
||||
else error $ ModuleName.toChars name ++ " in " ++ Pkg.toChars pkg ++ " references kernel code which has not been signed by Gren's lead developer."
|
||||
else return Nothing
|
||||
else return $ Left CrawlUnsignedKernelCode
|
||||
else return $ Left CrawlCorruption
|
||||
|
||||
crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> Bool -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
|
||||
crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> Bool -> ModuleName.Raw -> FilePath -> IO (Either CrawlError Status)
|
||||
crawlFile foreignDeps mvar pkg src docsStatus authorizedForKernelCode expectedName path =
|
||||
do
|
||||
bytes <- File.readUtf8 path
|
||||
@ -518,9 +526,9 @@ crawlFile foreignDeps mvar pkg src docsStatus authorizedForKernelCode expectedNa
|
||||
Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _ _ _) | expectedName == actualName ->
|
||||
do
|
||||
deps <- crawlImports foreignDeps mvar pkg authorizedForKernelCode src (fmap snd imports)
|
||||
return (Just (SLocal docsStatus deps modul))
|
||||
return (Right (SLocal docsStatus deps modul))
|
||||
_ ->
|
||||
return Nothing
|
||||
return $ Left CrawlCorruption
|
||||
|
||||
crawlImports :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> Bool -> FilePath -> [Src.Import] -> IO (Map.Map ModuleName.Raw ())
|
||||
crawlImports foreignDeps mvar pkg authorizedForKernelCode src imports =
|
||||
@ -533,7 +541,7 @@ crawlImports foreignDeps mvar pkg authorizedForKernelCode src imports =
|
||||
mapM_ readMVar mvars
|
||||
return deps
|
||||
|
||||
crawlKernel :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> IO (Maybe Status)
|
||||
crawlKernel :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> IO (Either CrawlError Status)
|
||||
crawlKernel foreignDeps mvar pkg src name =
|
||||
do
|
||||
let path = src </> ModuleName.toFilePath name <.> "js"
|
||||
@ -543,12 +551,12 @@ crawlKernel foreignDeps mvar pkg src name =
|
||||
bytes <- File.readUtf8 path
|
||||
case Kernel.fromByteString pkg (Map.mapMaybe getDepHome foreignDeps) bytes of
|
||||
Nothing ->
|
||||
return Nothing
|
||||
return $ Left CrawlCorruption
|
||||
Just (Kernel.Content imports chunks) ->
|
||||
do
|
||||
_ <- crawlImports foreignDeps mvar pkg True src imports
|
||||
return (Just (SKernelLocal chunks))
|
||||
else return (Just SKernelForeign)
|
||||
return (Right (SKernelLocal chunks))
|
||||
else return (Right SKernelForeign)
|
||||
|
||||
getDepHome :: ForeignInterface -> Maybe Pkg.Name
|
||||
getDepHome fi =
|
||||
|
||||
@ -1757,6 +1757,7 @@ data Details
|
||||
|
||||
data DetailsBadDep
|
||||
= BD_BadBuild Pkg.Name V.Version (Map.Map Pkg.Name V.Version)
|
||||
| BD_UnsignedBuild Pkg.Name V.Version
|
||||
|
||||
toDetailsReport :: Details -> Help.Report
|
||||
toDetailsReport details =
|
||||
@ -1857,23 +1858,36 @@ toDetailsReport details =
|
||||
Nothing
|
||||
"I ran into a compilation error when trying to build the following package:"
|
||||
[ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ " " ++ V.toChars vsn,
|
||||
D.reflow $
|
||||
D.reflow
|
||||
"This probably means it has package constraints that are too wide. It may be\
|
||||
\ possible to tweak your gren.json to avoid the root problem as a stopgap. Head\
|
||||
\ over to https://gren-lang.org/community to get help figuring out how to take\
|
||||
\ this path!",
|
||||
D.toSimpleNote $
|
||||
D.toSimpleNote
|
||||
"To help with the root problem, please report this to the package author along\
|
||||
\ with the following information:",
|
||||
D.indent 4 $
|
||||
D.vcat $
|
||||
map (\(p, v) -> D.fromChars $ Pkg.toChars p ++ " " ++ V.toChars v) $
|
||||
Map.toList fingerprint,
|
||||
D.reflow $
|
||||
D.reflow
|
||||
"If you want to help out even more, try building the package locally. That should\
|
||||
\ give you much more specific information about why this package is failing to\
|
||||
\ build, which will in turn make it easier for the package author to fix it!"
|
||||
]
|
||||
BD_UnsignedBuild pkg vsn ->
|
||||
Help.report
|
||||
"PROBLEM BUILDING DEPENDENCIES (UNSIGNED KERNEL CODE)"
|
||||
Nothing
|
||||
"I ran into a compilation error when trying to build the following package:"
|
||||
[ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ " " ++ V.toChars vsn,
|
||||
D.reflow
|
||||
"This package contains kernel code which has not been signed by the lead\
|
||||
\ developer of Gren. Kernel code can violate all the guarantees that Gren\
|
||||
\ provide, and is therefore carefully managed.",
|
||||
D.toSimpleNote $
|
||||
"To help with the root problem, please report this to the package author."
|
||||
]
|
||||
DetailsDuplicatedDep pkg ->
|
||||
Help.report
|
||||
"DUPLICATED DEPENDENCY"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user