diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,10 @@ +### 0.6.0.0 + +- *nhm-tool*: add command *plan* to print the build plan or its derivatives. + Command *deps* is now a synonym for command *plan deps*. +- *nhm-tool*: generate more secure *Makefile* with variables surrounded by + commas in shell parts. + ### 0.5.6.0 - *nhm-tool*: Cabal *3.12* generates paths with *Project Unit Id* for GHC diff --git a/ngx-export-distribution.cabal b/ngx-export-distribution.cabal --- a/ngx-export-distribution.cabal +++ b/ngx-export-distribution.cabal @@ -1,5 +1,5 @@ name: ngx-export-distribution -version: 0.5.6.0 +version: 0.6.0.0 synopsis: Build custom libraries for Nginx Haskell module description: Build custom libraries for . diff --git a/nhm-tool.hs b/nhm-tool.hs --- a/nhm-tool.hs +++ b/nhm-tool.hs @@ -39,12 +39,16 @@ defaultDistDataDir :: String defaultDistDataDir = ".hslibs" -data DepsData = DepsData { depsDataBuilddir :: String - , depsDataProject :: String - , depsDataWaitArg :: Maybe String - , depsDataHelp :: Bool +data PlanData = PlanData { planDataBuilddir :: String + , planDataQuery :: Maybe PlanDataQuery + , planDataWaitArg :: Maybe String + , planDataWaitProjectName :: Bool + , planDataHelp :: Bool } +data PlanDataQuery = PlanDataQueryDeps String + | PlanDataQueryAbi + data InitData = InitData { initDataPrefix :: String , initDataNoThreaded :: Bool , initDataForce :: Bool @@ -63,8 +67,11 @@ | LibOther String (Maybe FilePath) deriving Show -data HelpSection = HelpDist | HelpDeps | HelpInit deriving Eq +data HelpSection = HelpDist | HelpPlan | HelpDeps | HelpInit deriving Eq +replaceChar :: Char -> Char -> String -> String +replaceChar from to = map $ \v -> if v == from then to else v + progVersion :: String progVersion = "nhm-tool " ++ showVersion version @@ -95,15 +102,21 @@ \ special value '-' for 'dir', 'target_dir', and 'ar' resets them\n\ \ (with -d- being equivalent to -p)" ] - when (isNothing section || section == Just HelpDeps) $ + when (isNothing section || section `elem` map Just [HelpPlan, HelpDeps]) $ T.putStrLn "\n\ - \ * nhm-tool deps [-d dir] project-name\n\n\ - \ print all direct dependencies of 'project-name',\n\ - \ the output is compatible with the format of GHC environment \ - \files\n\n\ + \ * nhm-tool plan [-d dir] [deps project-name | abi]\n\n\ + \ print build plan or its derivatives:\n\ + \ 'deps' print all direct dependencies of 'project-name',\n\ + \ the output is compatible with the format of GHC environment \ + \files\n\ + \ 'abi' print 'Arch-Os-CompilerId' bundle in GHC style\n\n\ \ 'dir' is the cabal build directory where the build plan is \ \located\n\ \ (default is dist-newstyle)" + when (isNothing section || section == Just HelpDeps) $ + T.putStrLn "\n\ + \ * nhm-tool deps [-d dir] project-name\n\n\ + \ synonym for 'nhm-tool plan [-d dir] deps project-name'" when (isNothing section || section == Just HelpInit) $ T.putStrLn $ T.concat ["\n\ \ * nhm-tool init [-p dir] [-no-threaded] [-f | -to-stdout] \ @@ -141,18 +154,30 @@ || null distDataTargetLib -> usage (Just HelpDist) False | otherwise -> cmdDist distData' + "plan" : args' -> do + let planData = foldl parsePlanArg (Just defaultArgs) args' + defaultArgs = PlanData "" Nothing Nothing False False + case planData of + Nothing -> usage (Just HelpPlan) False + Just planData'@PlanData {..} -> + if | planDataHelp -> + usage (Just HelpPlan) $ length args' == 1 + | isJust planDataWaitArg + || planDataWaitProjectName -> + usage (Just HelpPlan) False + | otherwise -> cmdPlan planData' "deps" : args' -> do - let depsData = foldl parseDepsArg (Just defaultArgs) args' - defaultArgs = DepsData "" "" Nothing False - case depsData of + let planData = foldl parsePlanArg (Just defaultArgs) args' + defaultArgs = PlanData "" Nothing Nothing True False + case planData of Nothing -> usage (Just HelpDeps) False - Just depsData'@DepsData {..} -> - if | depsDataHelp -> + Just planData'@PlanData {..} -> + if | planDataHelp -> usage (Just HelpDeps) $ length args' == 1 - | isJust depsDataWaitArg - || null depsDataProject -> + | isJust planDataWaitArg + || planDataWaitProjectName -> usage (Just HelpDeps) False - | otherwise -> cmdDeps depsData' + | otherwise -> cmdPlan planData' "init" : args' -> do let initData = foldl parseInitArg (Just defaultArgs) args' defaultArgs = InitData defaultInitDataPrefix False False False @@ -222,29 +247,37 @@ Just "-t" -> Just dist' { distDataTargetDir = arg } Just "-a" -> Just dist' { distDataArchive = arg } Just _ -> undefined - where dist' = dist { distDataWaitArg = Nothing } + where dist' = dist { distDataWaitArg = Nothing } -parseDepsArg :: Maybe DepsData -> String -> Maybe DepsData -parseDepsArg Nothing _ = Nothing -parseDepsArg (Just deps@DepsData {..}) arg = - case depsDataWaitArg of +parsePlanArg :: Maybe PlanData -> String -> Maybe PlanData +parsePlanArg Nothing _ = Nothing +parsePlanArg (Just plan@PlanData {..}) arg = + case planDataWaitArg of Nothing -> let (opt, value) = splitAt 2 arg - in if | "-d" == opt -> + in if | "deps" == arg && not hasDataQuery -> + Just plan' { planDataWaitProjectName = True } + | "abi" == arg && not hasDataQuery -> + Just plan' { planDataQuery = Just PlanDataQueryAbi } + | "-d" == opt -> Just $ if null value - then deps { depsDataWaitArg = Just opt } - else deps' { depsDataBuilddir = value } + then plan { planDataWaitArg = Just opt } + else plan' { planDataBuilddir = value } | (`elem` ["-h", "-help", "--help"]) arg -> - Just deps' { depsDataHelp = True } + Just plan' { planDataHelp = True } | Just '-' == (fst <$> uncons arg) -> Nothing - | null depsDataProject -> - Just deps' { depsDataProject = arg } + | planDataWaitProjectName -> + Just plan' + { planDataQuery = Just $ PlanDataQueryDeps arg + , planDataWaitProjectName = False + } | otherwise -> Nothing - Just "-d" -> Just deps' { depsDataBuilddir = arg } + Just "-d" -> Just plan' { planDataBuilddir = arg } Just _ -> undefined - where deps' = deps { depsDataWaitArg = Nothing } + where plan' = plan { planDataWaitArg = Nothing } + hasDataQuery = isJust planDataQuery || planDataWaitProjectName parseInitArg :: Maybe InitData -> String -> Maybe InitData parseInitArg Nothing _ = Nothing @@ -272,56 +305,44 @@ Nothing Just "-p" -> Just init'' { initDataPrefix = arg } Just _ -> undefined - where init'' = init' { initDataWaitArg = Nothing } + where init'' = init' { initDataWaitArg = Nothing } cmdDist :: DistData -> IO () cmdDist DistData {..} = do - let pdb = emptyProgramDb - patchelf = simpleProgram "patchelf" - (patchelf', pdb') <- requireProgram distDataOtherVerbosity patchelf pdb + patchelf <- requireProgram' $ simpleProgram "patchelf" if distDataPatchOnly - then patchTargetLib patchelf' + then patchTargetLib patchelf else do - let ldd = simpleProgram "ldd" - (ldd', pdb'') <- requireProgram distDataOtherVerbosity ldd pdb' + ldd <- requireProgram' $ simpleProgram "ldd" putStrLn' "---> Collecting libraries" - lddOut <- getProgramOutput distDataOtherVerbosity - ldd' [distDataTargetLib] + lddOut <- getProgramOutput' ldd [distDataTargetLib] case parseLddOutput lddOut of Left err -> do hPutStrLn stderr $ show err ++ " in\n" ++ lddOut exitFailure Right recs -> do - (tar', _) <- requireProgram distDataOtherVerbosity - tarProgram pdb'' + tar' <- requireProgram' tarProgram collectLibs recs lddOut unless (null distDataTargetDir) $ - putStrLn' "" >> patchTargetLib patchelf' + putStrLn' "" >> patchTargetLib patchelf unless (null distDataArchive) $ putStrLn' "" >> archiveLibs tar' - where patchTargetLib patchelf' - | null distDataTargetDir = return () - | otherwise = do - putStrLn' $ "---> Patching " ++ distDataTargetLib - patchelfOut <- getProgramOutput distDataOtherVerbosity - patchelf' ["--print-rpath", distDataTargetLib] - case parsePatchelfRpathOutput patchelfOut of - Left err -> do - hPutStrLn stderr $ show err ++ " in\n" ++ patchelfOut - exitFailure - Right paths -> do - unless (distDataTargetDir `elem` paths) $ - runProgram distDataOtherVerbosity patchelf' - ["--set-rpath" - ,distDataTargetDir ++ ':' : patchelfOut - ,distDataTargetLib - ] - patchelfOut' <- getProgramOutput - distDataOtherVerbosity - patchelf' ["--print-rpath" - ,distDataTargetLib - ] - putStrLnTrim patchelfOut' + where patchTargetLib patchelf = unless (null distDataTargetDir) $ do + putStrLn' $ "---> Patching " ++ distDataTargetLib + let printRpath = getProgramOutput' + patchelf ["--print-rpath", distDataTargetLib] + patchelfOut <- printRpath + case parsePatchelfRpathOutput patchelfOut of + Left err -> do + hPutStrLn stderr $ show err ++ " in\n" ++ patchelfOut + exitFailure + Right paths -> do + unless (distDataTargetDir `elem` paths) $ runProgram' + patchelf ["--set-rpath" + ,distDataTargetDir ++ ':' : patchelfOut + ,distDataTargetLib + ] + printRpath >>= putStrLnTrim collectLibs recs lddOut = do let recsLibHS = M.fromList $ mapMaybe (\case @@ -350,24 +371,21 @@ show (M.keys recsLibHSNotFound) ++ " were not found in\n" ++ lddOut exitFailure - archiveLibs tar' - | null distDataArchive = return () - | otherwise = do - putStrLn' "---> Archiving artifacts" - tarOut <- getProgramOutput distDataOtherVerbosity tar' - ["czvf" - ,distDataArchive <.> ".tar.gz" - ,distDataTargetLib - ,distDataDir - ] - putStrLnTrim tarOut + archiveLibs tar' = unless (null distDataArchive) $ do + putStrLn' "---> Archiving artifacts" + tarOut <- getProgramOutput' + tar' ["czvf" + ,distDataArchive <.> ".tar.gz" + ,distDataTargetLib + ,distDataDir + ] + putStrLnTrim tarOut + requireProgram' = fmap fst . + flip (requireProgram distDataOtherVerbosity) emptyProgramDb + getProgramOutput' = getProgramOutput distDataOtherVerbosity + runProgram' = runProgram distDataOtherVerbosity putStrLn' = when (distDataOwnVerbosity == verbose) . putStrLn - putStrLnTrim = putStrLn' . trimEnd '\n' - trimEnd end = fst . foldr (\v a@(vs, skipped) -> - if skipped || v /= end - then (v : vs, True) - else a - ) ("", False) + putStrLnTrim = putStrLn' . dropWhileEnd (== '\n') parsePatchelfRpathOutput :: String -> Either ParseError [String] parsePatchelfRpathOutput = @@ -395,28 +413,38 @@ sep = spaces1 *> string "=>" *> spaces1 spaces1 = skipMany1 space -cmdDeps :: DepsData -> IO () -cmdDeps DepsData {..} = do - let buildDir = if null depsDataBuilddir +cmdPlan :: PlanData -> IO () +cmdPlan PlanData {..} = do + let buildDir = if null planDataBuilddir then ProjectRelativeToDir "." - else InBuildDir depsDataBuilddir - units <- pjUnits <$> findAndDecodePlanJson buildDir - let comps = [ uComps - | Unit {..} <- M.elems units - , uType == UnitTypeLocal - , let uPkgName = (\(PkgId (PkgName name) _) -> name) uPId - , uPkgName == T.pack depsDataProject - ] - when (null comps) $ do - hPutStrLn stderr $ "Failed to find plan for " ++ depsDataProject - exitFailure - let deps = foldl (\a curComps -> - let libComps = M.filterWithKey - (const . (== CompNameLib)) curComps - in M.foldr S.union a $ M.map ciLibDeps libComps - ) S.empty comps - forM_ (S.toList deps) $ \(UnitId unit) -> - putStrLn $ "package-id " ++ T.unpack unit + else InBuildDir planDataBuilddir + path <- findPlanJson buildDir + case planDataQuery of + Nothing -> + readFile path >>= putStrLn + Just (PlanDataQueryDeps proj) -> do + units <- pjUnits <$> decodePlanJson path + let comps = [ uComps + | Unit {..} <- M.elems units + , uType == UnitTypeLocal + , let uPkgName = (\(PkgId (PkgName pkg) _) -> pkg) uPId + , uPkgName == T.pack proj + ] + when (null comps) $ do + hPutStrLn stderr $ "Failed to find plan for " ++ proj + exitFailure + let deps = foldl (\a curComps -> + let libComps = M.filterWithKey + (const . (== CompNameLib)) curComps + in M.foldr S.union a $ + M.map ciLibDeps libComps + ) S.empty comps + forM_ (S.toList deps) $ \(UnitId unit) -> + putStrLn $ "package-id " ++ T.unpack unit + Just PlanDataQueryAbi -> do + PlanJson {..} <- decodePlanJson path + T.putStrLn $ + T.intercalate "-" [pjArch, pjOs, dispPkgId pjCompilerId] cmdInit :: InitData -> IO () cmdInit init'@InitData {..} = do @@ -424,7 +452,7 @@ ,("Setup.hs", setupHs init', True) ,(initDataProject ++ ".cabal", projectCabal init', True) ,("Makefile", makefile init', True) - ,(replace '-' '_' initDataProject ++ ".hs" + ,(replaceChar '-' '_' initDataProject ++ ".hs" ,projectHs init' ,False ) @@ -443,8 +471,7 @@ then useForceMsg name else existsMsg name else T.writeFile name file - where replace from to = foldr (\v -> ((if v == from then to else v) :)) "" - printHeader header = do + where printHeader header = do isANSITerm <- hSupportsANSI stdout if isANSITerm then do @@ -494,7 +521,7 @@ makefile :: InitData -> Text makefile InitData {..} = T.concat - ["NAME := ", T.replace "-" "_" $ T.pack initDataProject, "\n\ + ["NAME := ", T.pack $ replaceChar '-' '_' initDataProject, "\n\ \PKGNAME := $(subst _,-,$(NAME))\n\ \PKGVER := 0.1.0.0\n\ \\n\ @@ -509,11 +536,11 @@ \LIB := $(NAME).so\n\ \DISTR := $(PKGNAME)-$(PKGVER).tar.gz\n\ \\n\ - \OBJS := $(SRC:.hs=.o)\n\ - \HIOBJS := $(SRC:.hs=.hi)\n\ - \DYNOBJS := $(SRC:.hs=.dyn_o)\n\ - \DYNHIOBJS := $(SRC:.hs=.dyn_hi)\n\ - \STUBS := $(SRC:.hs=_stub.h)\n\ + \override OBJS := $(SRC:.hs=.o)\n\ + \override HIOBJS := $(SRC:.hs=.hi)\n\ + \override DYNOBJS := $(SRC:.hs=.dyn_o)\n\ + \override DYNHIOBJS := $(SRC:.hs=.dyn_hi)\n\ + \override STUBS := $(SRC:.hs=_stub.h)\n\ \\n\ \GHC := ghc\n\ \CABAL := cabal\n\ @@ -546,53 +573,53 @@ \config: $(SETUPCONFIG)\n\ \\n\ \$(GHCENVLNK): cabal.project $(PKGNAME).cabal\n\ - \\trm -f $(GHCENVLNK)\n\ + \\trm -f \"$(GHCENVLNK)\"\n\ \\t$(CABAL) install --builddir=\"$(BUILDDIR)\" --lib --only-dependencies \ \\\\n\ \\t --package-env .\n\ - \\tsed -i 's/\\(^package-id \\)/--\\1/' $(GHCENV)\n", + \\tsed -i 's/\\(^package-id \\)/--\\1/' \"$(GHCENV)\"\n", updatePath, - "\t$(NHMTOOL) deps $(PKGNAME) -d \"$(BUILDDIR)\" >> $(GHCENV)\n\ - \\tln -sf $(GHCENV) $(GHCENVLNK)\n\ + "\t$(NHMTOOL) deps \"$(PKGNAME)\" -d \"$(BUILDDIR)\" >> \"$(GHCENV)\"\n\ + \\tln -sf \"$(GHCENV)\" \"$(GHCENVLNK)\"\n\ \\n\ \$(SETUPCONFIG): $(GHCENVLNK)\n", updatePath, "\trunhaskell --ghc-arg=-package=base \\\n\ - \\t --ghc-arg=-package=$(PKGDISTR) Setup.hs configure \\\n\ + \\t --ghc-arg=-package=\"$(PKGDISTR)\" Setup.hs configure \\\n\ \\t --builddir=\"$(BUILDDIR)\" \\\n\ \\t --package-db=clear --package-db=global \\\n\ - \\t $$(sed -n 's/^\\(package-db\\)\\s\\+/--\\1=/p' $(GHCENV)) \\\n\ + \\t $$(sed -n 's/^\\(package-db\\)\\s\\+/--\\1=/p' \"$(GHCENV)\") \\\n\ \\t $$(sed -n 's/^package-id\\s\\+\\(.*\\)'` \\\n\ \\t `'\\(-\\([0-9]\\+\\.\\)*[0-9]\\+\\($$\\|-.*\\)\\)/'` \\\n\ \\t `'--dependency=\\1=\\1\\2/p' \\\n\ - \\t $(GHCENV)) \\\n\ - \\t --prefix=$(PREFIX)\n\ + \\t \"$(GHCENV)\") \\\n\ + \\t --prefix=\"$(PREFIX)\"\n\ \\n\ \$(DISTR): $(SETUPCONFIG) $(SRC)\n", updatePath, "\trunhaskell --ghc-arg=-package=base \\\n\ - \\t --ghc-arg=-package=$(PKGDISTR) Setup.hs build \\\n\ + \\t --ghc-arg=-package=\"$(PKGDISTR)\" Setup.hs build \\\n\ \\t --builddir=\"$(BUILDDIR)\" \\\n\ \\t --ghc-options=\"$(SRC) -o $(LIB) $(LINKRTS)\"\n\ \\n\ \install: $(DISTR)\n\ - \\tinstall -d $(PREFIX)\n\ - \\ttar xf $(DISTR) -C $(PREFIX) --no-same-owner\n\ + \\tinstall -d \"$(PREFIX)\"\n\ + \\ttar xf \"$(DISTR)\" -C \"$(PREFIX)\" --no-same-owner\n\ \\n\ \clean:\n\ - \\trm -rf $(DEPLIBS)\n\ + \\trm -rf \"$(DEPLIBS)\"\n\ \\trm -f $(OBJS) $(HIOBJS) $(DYNOBJS) $(DYNHIOBJS) $(STUBS)\n\ - \\trm -f $(LIB)\n\ + \\trm -f \"$(LIB)\"\n\ \\n\ \clean-all: clean\n\ - \\trm -rf $(BUILDDIR)\n\ - \\trm -f $(GHCENV) $(GHCENVLNK) $(DISTR)\n" + \\trm -rf \"$(BUILDDIR)\"\n\ + \\trm -f \"$(GHCENV)\" \"$(GHCENVLNK)\" \"$(DISTR)\"\n" ] where updatePath = "\tif test \"$(NHMTOOL)\" = nhm-tool && ! command -v nhm-tool \ \>/dev/null; \\\n\ \\tthen \\\n\ - \\t PATH=$$(dirname $$($(CABAL) list-bin $(PKGDISTR) \\\n\ + \\t PATH=$$(dirname $$($(CABAL) list-bin \"$(PKGDISTR)\" \\\n\ \\t --builddir=\"$(BUILDDIR)\")):$$PATH; \\\n\ \\tfi; \\\n"