{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wall #-} -- | Replacement for debpool. module Options ( Params(..) , initialParams , homeParams , optSpecs ) where import Data.List (intercalate) import Debian.Repo.LocalRepository (Layout(..)) import Prelude hiding (putStr, putStrLn, putChar) import System.Console.GetOpt (ArgDescr(NoArg, ReqArg)) import System.Environment (getEnv) import Config (ParamDescr(..)) data Params = Params { verbosity :: Int , rootParam :: FilePath , uploadSection :: Maybe FilePath , expire :: Bool , binaryOrphans :: Bool , cleanUp :: Bool , dryRun :: Bool , removePackages :: [String] , install :: Bool , releases :: [String] , aliases :: [String] , sections :: [String] , replace :: Bool , notifyEmail :: [String] , senderEmail :: Maybe String , verify :: Bool , rejectRevision :: Maybe String , printVersion :: Bool , layout :: Layout , sign :: Bool , architectures :: Maybe String , keyName :: Maybe String -- "Name of the pgp key with which to sign the repository." } deriving Show initialParams :: Params initialParams = Params { verbosity = 0 , rootParam = "." , uploadSection = Nothing , expire = False , binaryOrphans = False , cleanUp = False , dryRun = False , removePackages = [] , install = True , releases = [] , aliases = [] , sections = [] , replace = False , notifyEmail = [] , senderEmail = Nothing , verify = False , rejectRevision = Nothing , printVersion = False , layout = Pool , sign = True , architectures = Nothing , keyName = Nothing } homeParams :: IO Params homeParams = getEnv "HOME" >>= \ home -> return $ initialParams {rootParam = home} optSpecs :: [ParamDescr (Params -> Params)] optSpecs = [ Param ['v'] ["verbose"] ["Verbose"] (NoArg (\ p -> p {verbosity = verbosity p + 1})) "Increase the amount of debugging output" , Param [] ["root"] ["Root"] (ReqArg (\ s p -> p {rootParam = s}) "PATH") "Specify the root directory of the repository" , Param [] ["section"] ["Section"] (ReqArg (\ s p -> p {uploadSection = Just s}) "PATH") "Force uploads to the specified section" , Param [] ["expire"] ["Expire"] (NoArg (\ p -> p {expire = True})) "Remove all packages trumped by newer versions from the package lists." , Param [] ["binary-orphans"] ["Binary-Orphans"] (NoArg (\ p -> p {binaryOrphans = True})) "Remove all binary packages that have no corresponding source package." , Param [] ["clean-up"] ["Clean-Up"] (NoArg (\ p -> p {cleanUp = True})) "Move all unreferenced files in the repository to the removed directory." , Param ['n'] ["dry-run"] ["Dry-Run"] (NoArg (\ p -> p {dryRun = True})) "Test run, don't modify the repository. (ONLY IMPLEMENTED FOR REMOVE)" , Param [] ["remove"] ["Remove"] (ReqArg (\ s p -> p {removePackages = removePackages p ++ [s]}) "DIST,SECTION,PACKAGE=VERSION") "remove a particular version of a package (may be repeated.)" , Param ['i'] ["install"] ["Install"] (NoArg (\ p -> p {install = True})) ("Scan the incoming directory and install the packages found there.\n" ++ "This option is automatically true if no --remove arguments are given.") , Param [] ["create-release"] ["Create-Release"] (ReqArg (\ s p -> p {releases = releases p ++ [s]}) "NAME") ("Create any new releases and/or sections found in Distribution\n" ++ "and Section fields of the uploaded .changes files.") , Param [] ["create-alias"] ["Create-Alias"] (ReqArg (\ s p -> p {aliases = aliases p ++ [s]}) "ALIAS=RELEASE") "Create an alias for an existing release" , Param [] ["create-section"] ["Create-Section"] (ReqArg (\ s p -> p {sections = sections p ++ [s]}) "RELEASE,SECTION") "Create a new section in the given release." , Param [] ["replace"] ["Replace"] (NoArg (\ p -> p {replace = True})) ("Permit uploading of a package whose version is already present.\n" ++ "This is normally an error.") , Param [] ["notify-email"] ["Notify-Email"] (ReqArg (\ s p -> p {notifyEmail = notifyEmail p ++ [s]}) "USER@HOST") "Email address to send notifications about success and failure of uploads." , Param [] ["sender-email"] ["Sender-Email"] (ReqArg (\ s p -> p {senderEmail = Just s}) "USER@HOST") "Sender address for notifications." , Param [] ["verify"] ["Verify"] (NoArg (\ p -> p {verify = True})) "Verify the structure and contents of the repository." , Param [] ["reject-revision"] ["Reject-Revision"] (ReqArg (\ s p -> p {rejectRevision = Just s}) "STRING") ("Disallow uploads of packages with this revision string. The\n" ++ "autobuilder gives 'dir' targets the revision string 'none', the\n" ++ "option 'Reject-Revision: none' can be used to prohibit uploads of\n" ++ "packages built from a 'dir' target.") , Param [] ["version"] ["Version"] (NoArg (\ p -> p {printVersion = True})) "Print the version string and exit" , Param [] ["layout"] ["Layout"] (ReqArg (\ s p -> p {layout = read s}) (intercalate " or " (map show ([minBound .. maxBound] :: [Layout])) ++ ", default " ++ show (layout initialParams))) "Specify a default layout" , Param [] ["no-sign"] ["No-Sign"] (NoArg (\ p -> p {sign = False})) "Do not attempt to cryptographically sign the repository, even if something changed." , Param [] ["sign"] ["Sign"] (NoArg (\ p -> p {sign = True})) "Cryptographically sign the repository, even if nothing changed." , Param [] ["architectures"] ["Architectures"] (ReqArg (\ s p -> p {architectures = Just s}) "ARCH,ARCH,...") "" , Param [] ["keyname"] ["Key-Name"] (ReqArg (\ s p -> p {keyName = Just s}) "STRING") "Name of the pgp key with which to sign the repository." {- , Param [] ["rebuild"] ["Rebuild"] (NoArg (Value "Rebuild" "yes")) "(UNIMPLEMENTED) Reconstruct the package lists from scratch." , Param [] ["obsolete"] ["Obsolete"] (NoArg (Value "Obsolete" "yes")) (My.consperse "\n" ["(UNIMPLEMENTED) Remove any package for which newer versions exist,", "remove any package which is not part of any dist."]) -} ]