X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/c03224f62c99031e750d0fcd926d52535a3ef430..385b2959745cb49e2c2da95ea4609c246fb2ac63:/src/Ganeti/HsConstants.hs diff --git a/src/Ganeti/HsConstants.hs b/src/Ganeti/HsConstants.hs index 195bc2f..b2d5452 100644 --- a/src/Ganeti/HsConstants.hs +++ b/src/Ganeti/HsConstants.hs @@ -36,15 +36,19 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} module Ganeti.HsConstants where +import Control.Arrow ((***)) import Data.List ((\\)) import Data.Map (Map) -import qualified Data.Map as Map (fromList) +import qualified Data.Map as Map (fromList, keys, insert) import AutoConf -import Ganeti.ConstantUtils (FrozenSet, Protocol(..), buildVersion) +import Ganeti.ConstantUtils (PythonChar(..), FrozenSet, Protocol(..), + buildVersion) import qualified Ganeti.ConstantUtils as ConstantUtils import Ganeti.Runtime (GanetiDaemon(..), MiscGroup(..), GanetiGroup(..), ExtraLogReason(..)) +import Ganeti.HTools.Types (AutoRepairResult(..), AutoRepairType(..)) +import qualified Ganeti.HTools.Types as Types import Ganeti.Logging (SyslogUsage(..)) import qualified Ganeti.Logging as Logging (syslogUsageToRaw) import qualified Ganeti.Runtime as Runtime @@ -153,6 +157,12 @@ osApiV20 = 20 osApiVersions :: FrozenSet Int osApiVersions = ConstantUtils.mkSet [osApiV10, osApiV15, osApiV20] +exportVersion :: Int +exportVersion = 0 + +rapiVersion :: Int +rapiVersion = 2 + configMajor :: Int configMajor = AutoConf.versionMajor @@ -222,6 +232,46 @@ sshLoginUser = AutoConf.sshLoginUser sshConsoleUser :: String sshConsoleUser = AutoConf.sshConsoleUser +-- * Cpu pinning separators and constants + +cpuPinningSep :: String +cpuPinningSep = ":" + +cpuPinningAll :: String +cpuPinningAll = "all" + +-- | Internal representation of "all" +cpuPinningAllVal :: Int +cpuPinningAllVal = -1 + +-- | One "all" entry in a CPU list means CPU pinning is off +cpuPinningOff :: [Int] +cpuPinningOff = [cpuPinningAllVal] + +-- | A Xen-specific implementation detail is that there is no way to +-- actually say "use any cpu for pinning" in a Xen configuration file, +-- as opposed to the command line, where you can say +-- @ +-- xm vcpu-pin all +-- @ +-- +-- The workaround used in Xen is "0-63" (see source code function +-- "xm_vcpu_pin" in @/tools/python/xen/xm/main.py@). +-- +-- To support future changes, the following constant is treated as a +-- blackbox string that simply means "use any cpu for pinning under +-- xen". +cpuPinningAllXen :: String +cpuPinningAllXen = "0-63" + +-- | A KVM-specific implementation detail - the following value is +-- used to set CPU affinity to all processors (--0 through --31), per +-- taskset man page. +-- +-- FIXME: This only works for machines with up to 32 CPU cores +cpuPinningAllKvm :: Int +cpuPinningAllKvm = 0xFFFFFFFF + -- * Wipe ddCmd :: String @@ -339,6 +389,27 @@ extraLogreasonError = Runtime.daemonsExtraLogbase GanetiMond ErrorLog devConsole :: String devConsole = ConstantUtils.devConsole +procMounts :: String +procMounts = "/proc/mounts" + +-- * Luxi (Local UniX Interface) related constants + +luxiEom :: PythonChar +luxiEom = PythonChar '\x03' + +-- | Environment variable for the luxi override socket +luxiOverride :: String +luxiOverride = "FORCE_LUXI_SOCKET" + +luxiOverrideMaster :: String +luxiOverrideMaster = "master" + +luxiOverrideQuery :: String +luxiOverrideQuery = "query" + +luxiVersion :: Int +luxiVersion = configVersion + -- * Syslog syslogUsage :: String @@ -356,6 +427,9 @@ syslogOnly = Logging.syslogUsageToRaw SyslogOnly syslogSocket :: String syslogSocket = "/dev/log" +exportConfFile :: String +exportConfFile = "config.ini" + -- * Xen xenBootloader :: String @@ -398,6 +472,148 @@ socatUseCompress = AutoConf.socatUseCompress socatUseEscape :: Bool socatUseEscape = AutoConf.socatUseEscape +-- * Console types + +-- | Display a message for console access +consMessage :: String +consMessage = "msg" + +-- | Console as SPICE server +consSpice :: String +consSpice = "spice" + +-- | Console as SSH command +consSsh :: String +consSsh = "ssh" + +-- | Console as VNC server +consVnc :: String +consVnc = "vnc" + +consAll :: FrozenSet String +consAll = ConstantUtils.mkSet [consMessage, consSpice, consSsh, consVnc] + +-- | RSA key bit length +-- +-- For RSA keys more bits are better, but they also make operations +-- more expensive. NIST SP 800-131 recommends a minimum of 2048 bits +-- from the year 2010 on. +rsaKeyBits :: Int +rsaKeyBits = 2048 + +-- | Ciphers allowed for SSL connections. +-- +-- For the format, see ciphers(1). A better way to disable ciphers +-- would be to use the exclamation mark (!), but socat versions below +-- 1.5 can't parse exclamation marks in options properly. When +-- modifying the ciphers, ensure not to accidentially add something +-- after it's been removed. Use the "openssl" utility to check the +-- allowed ciphers, e.g. "openssl ciphers -v HIGH:-DES". +opensslCiphers :: String +opensslCiphers = "HIGH:-DES:-3DES:-EXPORT:-ADH" + +-- * X509 + +-- | commonName (CN) used in certificates +x509CertCn :: String +x509CertCn = "ganeti.example.com" + +-- | Default validity of certificates in days +x509CertDefaultValidity :: Int +x509CertDefaultValidity = 365 * 5 + +x509CertSignatureHeader :: String +x509CertSignatureHeader = "X-Ganeti-Signature" + +-- | Digest used to sign certificates ("openssl x509" uses SHA1 by default) +x509CertSignDigest :: String +x509CertSignDigest = "SHA1" + +-- * Import/export daemon mode + +iemExport :: String +iemExport = "export" + +iemImport :: String +iemImport = "import" + +-- * Import/export transport compression + +iecGzip :: String +iecGzip = "gzip" + +iecNone :: String +iecNone = "none" + +iecAll :: [String] +iecAll = [iecGzip, iecNone] + +ieCustomSize :: String +ieCustomSize = "fd" + +-- * Import/export I/O + +-- | Direct file I/O, equivalent to a shell's I/O redirection using +-- '<' or '>' +ieioFile :: String +ieioFile = "file" + +-- | Raw block device I/O using "dd" +ieioRawDisk :: String +ieioRawDisk = "raw" + +-- | OS definition import/export script +ieioScript :: String +ieioScript = "script" + +-- * Hooks + +hooksNameCfgupdate :: String +hooksNameCfgupdate = "config-update" + +hooksNameWatcher :: String +hooksNameWatcher = "watcher" + +hooksPath :: String +hooksPath = "/sbin:/bin:/usr/sbin:/usr/bin" + +hooksPhasePost :: String +hooksPhasePost = "post" + +hooksPhasePre :: String +hooksPhasePre = "pre" + +hooksVersion :: Int +hooksVersion = 2 + +-- * Hooks subject type (what object type does the LU deal with) + +htypeCluster :: String +htypeCluster = "CLUSTER" + +htypeGroup :: String +htypeGroup = "GROUP" + +htypeInstance :: String +htypeInstance = "INSTANCE" + +htypeNetwork :: String +htypeNetwork = "NETWORK" + +htypeNode :: String +htypeNode = "NODE" + +-- * Hkr + +hkrSkip :: Int +hkrSkip = 0 + +hkrFail :: Int +hkrFail = 1 + +hkrSuccess :: Int +hkrSuccess = 2 + -- * Storage types stBlock :: String @@ -424,6 +640,13 @@ stRados = Types.storageTypeToRaw StorageRados storageTypes :: FrozenSet String storageTypes = ConstantUtils.mkSet $ map Types.storageTypeToRaw [minBound..] +-- | The set of storage types for which storage reporting is available +-- +-- FIXME: Remove this, once storage reporting is available for all +-- types. +stsReport :: FrozenSet String +stsReport = ConstantUtils.mkSet [stFile, stLvmPv, stLvmVg] + -- * Storage fields -- ** First two are valid in LU context only, not passed to backend @@ -450,6 +673,65 @@ sfSize = Types.storageFieldToRaw SFSize sfUsed :: String sfUsed = Types.storageFieldToRaw SFUsed +validStorageFields :: FrozenSet String +validStorageFields = + ConstantUtils.mkSet $ map Types.storageFieldToRaw [minBound..] ++ + [sfNode, sfType] + +modifiableStorageFields :: Map String (FrozenSet String) +modifiableStorageFields = + Map.fromList [(Types.storageTypeToRaw StorageLvmPv, + ConstantUtils.mkSet [sfAllocatable])] + +-- * Storage operations + +soFixConsistency :: String +soFixConsistency = "fix-consistency" + +validStorageOperations :: Map String (FrozenSet String) +validStorageOperations = + Map.fromList [(Types.storageTypeToRaw StorageLvmVg, + ConstantUtils.mkSet [soFixConsistency])] + +-- * Volume fields + +vfDev :: String +vfDev = "dev" + +vfInstance :: String +vfInstance = "instance" + +vfName :: String +vfName = "name" + +vfNode :: String +vfNode = "node" + +vfPhys :: String +vfPhys = "phys" + +vfSize :: String +vfSize = "size" + +vfVg :: String +vfVg = "vg" + +-- * Local disk status + +ldsFaulty :: Int +ldsFaulty = Types.localDiskStatusToRaw DiskStatusFaulty + +ldsOkay :: Int +ldsOkay = Types.localDiskStatusToRaw DiskStatusOk + +ldsUnknown :: Int +ldsUnknown = Types.localDiskStatusToRaw DiskStatusUnknown + +ldsNames :: Map Int String +ldsNames = + Map.fromList [ (Types.localDiskStatusToRaw ds, + localDiskStatusName ds) | ds <- [minBound..] ] + -- * Disk template types dtDiskless :: String @@ -493,6 +775,121 @@ diskTemplates = ConstantUtils.mkSet $ map Types.diskTemplateToRaw [minBound..] defaultEnabledDiskTemplates :: [String] defaultEnabledDiskTemplates = map Types.diskTemplateToRaw [DTDrbd8, DTPlain] +-- | Mapping of disk templates to storage types +mapDiskTemplateStorageType :: Map String String +mapDiskTemplateStorageType = + Map.fromList $ + map (Types.diskTemplateToRaw *** Types.storageTypeToRaw) + [(DTBlock, StorageBlock), + (DTDrbd8, StorageLvmVg), + (DTExt, StorageExt), + (DTSharedFile, StorageFile), + (DTFile, StorageFile), + (DTDiskless, StorageDiskless), + (DTPlain, StorageLvmVg), + (DTRbd, StorageRados)] + +-- | The set of network-mirrored disk templates +dtsIntMirror :: FrozenSet String +dtsIntMirror = ConstantUtils.mkSet [dtDrbd8] + +-- | 'DTDiskless' is 'trivially' externally mirrored +dtsExtMirror :: FrozenSet String +dtsExtMirror = + ConstantUtils.mkSet $ + map Types.diskTemplateToRaw [DTDiskless, DTBlock, DTExt, DTSharedFile, DTRbd] + +-- | The set of non-lvm-based disk templates +dtsNotLvm :: FrozenSet String +dtsNotLvm = + ConstantUtils.mkSet $ + map Types.diskTemplateToRaw + [DTSharedFile, DTDiskless, DTBlock, DTExt, DTFile, DTRbd] + +-- | The set of disk templates which can be grown +dtsGrowable :: FrozenSet String +dtsGrowable = + ConstantUtils.mkSet $ + map Types.diskTemplateToRaw + [DTSharedFile, DTDrbd8, DTPlain, DTExt, DTFile, DTRbd] + +-- | The set of disk templates that allow adoption +dtsMayAdopt :: FrozenSet String +dtsMayAdopt = + ConstantUtils.mkSet $ map Types.diskTemplateToRaw [DTBlock, DTPlain] + +-- | The set of disk templates that *must* use adoption +dtsMustAdopt :: FrozenSet String +dtsMustAdopt = ConstantUtils.mkSet [Types.diskTemplateToRaw DTBlock] + +-- | The set of disk templates that allow migrations +dtsMirrored :: FrozenSet String +dtsMirrored = dtsIntMirror `ConstantUtils.union` dtsExtMirror + +-- | The set of file based disk templates +dtsFilebased :: FrozenSet String +dtsFilebased = + ConstantUtils.mkSet $ map Types.diskTemplateToRaw [DTSharedFile, DTFile] + +-- | The set of disk templates that can be moved by copying +-- +-- Note: a requirement is that they're not accessed externally or +-- shared between nodes; in particular, sharedfile is not suitable. +dtsCopyable :: FrozenSet String +dtsCopyable = + ConstantUtils.mkSet $ map Types.diskTemplateToRaw [DTPlain, DTFile] + +-- | The set of disk templates that are supported by exclusive_storage +dtsExclStorage :: FrozenSet String +dtsExclStorage = ConstantUtils.mkSet $ map Types.diskTemplateToRaw [DTPlain] + +-- | Templates for which we don't perform checks on free space +dtsNoFreeSpaceCheck :: FrozenSet String +dtsNoFreeSpaceCheck = + ConstantUtils.mkSet $ + map Types.diskTemplateToRaw [DTExt, DTSharedFile, DTFile, DTRbd] + +dtsBlock :: FrozenSet String +dtsBlock = + ConstantUtils.mkSet $ + map Types.diskTemplateToRaw [DTPlain, DTDrbd8, DTBlock, DTRbd, DTExt] + +-- * Drbd + +drbdHmacAlg :: String +drbdHmacAlg = "md5" + +drbdDefaultNetProtocol :: String +drbdDefaultNetProtocol = "C" + +drbdMigrationNetProtocol :: String +drbdMigrationNetProtocol = "C" + +drbdStatusFile :: String +drbdStatusFile = "/proc/drbd" + +-- | Size of DRBD meta block device +drbdMetaSize :: Int +drbdMetaSize = 128 + +-- * Drbd barrier types + +drbdBDiskBarriers :: String +drbdBDiskBarriers = "b" + +drbdBDiskDrain :: String +drbdBDiskDrain = "d" + +drbdBDiskFlush :: String +drbdBDiskFlush = "f" + +drbdBNone :: String +drbdBNone = "n" + +-- | Rbd tool command +rbdCmd :: String +rbdCmd = "rbd" + -- * File backend driver fdBlktap :: String @@ -501,6 +898,15 @@ fdBlktap = Types.fileDriverToRaw FileBlktap fdLoop :: String fdLoop = Types.fileDriverToRaw FileLoop +fileDriver :: FrozenSet String +fileDriver = + ConstantUtils.mkSet $ + map Types.fileDriverToRaw [minBound..] + +-- | The set of drbd-like disk types +ldsDrbd :: FrozenSet String +ldsDrbd = ConstantUtils.mkSet [Types.diskTemplateToRaw DTDrbd8] + -- * Disk access mode diskRdonly :: String @@ -556,6 +962,51 @@ instanceCreateModes :: FrozenSet String instanceCreateModes = ConstantUtils.mkSet $ map Types.instCreateModeToRaw [minBound..] +-- * Remote import/export handshake message and version + +rieHandshake :: String +rieHandshake = "Hi, I'm Ganeti" + +rieVersion :: Int +rieVersion = 0 + +-- | Remote import/export certificate validity in seconds +rieCertValidity :: Int +rieCertValidity = 24 * 60 * 60 + +-- | Export only: how long to wait per connection attempt (seconds) +rieConnectAttemptTimeout :: Int +rieConnectAttemptTimeout = 20 + +-- | Export only: number of attempts to connect +rieConnectRetries :: Int +rieConnectRetries = 10 + +-- | Overall timeout for establishing connection +rieConnectTimeout :: Int +rieConnectTimeout = 180 + +-- | Give child process up to 5 seconds to exit after sending a signal +childLingerTimeout :: Double +childLingerTimeout = 5.0 + +-- * Import/export config options + +inisectBep :: String +inisectBep = "backend" + +inisectExp :: String +inisectExp = "export" + +inisectHyp :: String +inisectHyp = "hypervisor" + +inisectIns :: String +inisectIns = "instance" + +inisectOsp :: String +inisectOsp = "os" + -- * Dynamic device modification ddmAdd :: String @@ -624,14 +1075,99 @@ maxTagLen = 128 maxTagsPerObj :: Int maxTagsPerObj = 4096 +-- * Others + +defaultBridge :: String +defaultBridge = "xen-br0" + +defaultOvs :: String +defaultOvs = "switch1" + +-- | 60 MiB, expressed in KiB +classicDrbdSyncSpeed :: Int +classicDrbdSyncSpeed = 60 * 1024 + +ip4AddressAny :: String +ip4AddressAny = "0.0.0.0" + +ip4AddressLocalhost :: String +ip4AddressLocalhost = "127.0.0.1" + +ip6AddressAny :: String +ip6AddressAny = "::" + +ip6AddressLocalhost :: String +ip6AddressLocalhost = "::1" + +ip4Version :: Int +ip4Version = 4 + +ip6Version :: Int +ip6Version = 6 + +validIpVersions :: FrozenSet Int +validIpVersions = ConstantUtils.mkSet [ip4Version, ip6Version] + +tcpPingTimeout :: Int +tcpPingTimeout = 10 + +defaultVg :: String +defaultVg = "xenvg" + +defaultDrbdHelper :: String +defaultDrbdHelper = "/bin/true" + +minVgSize :: Int +minVgSize = 20480 + +defaultMacPrefix :: String +defaultMacPrefix = "aa:00:00" + +-- | Default maximum instance wait time, in seconds. +defaultShutdownTimeout :: Int +defaultShutdownTimeout = 120 + -- | Node clock skew in seconds nodeMaxClockSkew :: Int nodeMaxClockSkew = 150 +-- | Time for an intra-cluster disk transfer to wait for a connection +diskTransferConnectTimeout :: Int +diskTransferConnectTimeout = 60 + -- | Disk index separator diskSeparator :: String diskSeparator = AutoConf.diskSeparator +ipCommandPath :: String +ipCommandPath = AutoConf.ipPath + +-- | Key for job IDs in opcode result +jobIdsKey :: String +jobIdsKey = "jobs" + +-- * Runparts results + +runpartsErr :: Int +runpartsErr = 2 + +runpartsRun :: Int +runpartsRun = 1 + +runpartsSkip :: Int +runpartsSkip = 0 + +runpartsStatus :: [Int] +runpartsStatus = [runpartsErr, runpartsRun, runpartsSkip] + +-- * RPC + +rpcEncodingNone :: Int +rpcEncodingNone = 0 + +rpcEncodingZlibBase64 :: Int +rpcEncodingZlibBase64 = 1 + -- * Timeout table -- -- Various time constants for the timeout table @@ -664,8 +1200,98 @@ rpcTmo_1day = Types.rpcTimeoutToRaw OneDay rpcConnectTimeout :: Int rpcConnectTimeout = 5 -ipCommandPath :: String -ipCommandPath = AutoConf.ipPath +-- OS + +osScriptCreate :: String +osScriptCreate = "create" + +osScriptExport :: String +osScriptExport = "export" + +osScriptImport :: String +osScriptImport = "import" + +osScriptRename :: String +osScriptRename = "rename" + +osScriptVerify :: String +osScriptVerify = "verify" + +osScripts :: [String] +osScripts = [osScriptCreate, osScriptExport, osScriptImport, osScriptRename, + osScriptVerify] + +osApiFile :: String +osApiFile = "ganeti_api_version" + +osVariantsFile :: String +osVariantsFile = "variants.list" + +osParametersFile :: String +osParametersFile = "parameters.list" + +osValidateParameters :: String +osValidateParameters = "parameters" + +osValidateCalls :: FrozenSet String +osValidateCalls = ConstantUtils.mkSet [osValidateParameters] + +-- | External Storage (ES) related constants + +esActionAttach :: String +esActionAttach = "attach" + +esActionCreate :: String +esActionCreate = "create" + +esActionDetach :: String +esActionDetach = "detach" + +esActionGrow :: String +esActionGrow = "grow" + +esActionRemove :: String +esActionRemove = "remove" + +esActionSetinfo :: String +esActionSetinfo = "setinfo" + +esActionVerify :: String +esActionVerify = "verify" + +esScriptCreate :: String +esScriptCreate = esActionCreate + +esScriptRemove :: String +esScriptRemove = esActionRemove + +esScriptGrow :: String +esScriptGrow = esActionGrow + +esScriptAttach :: String +esScriptAttach = esActionAttach + +esScriptDetach :: String +esScriptDetach = esActionDetach + +esScriptSetinfo :: String +esScriptSetinfo = esActionSetinfo + +esScriptVerify :: String +esScriptVerify = esActionVerify + +esScripts :: FrozenSet String +esScripts = + ConstantUtils.mkSet [esScriptAttach, + esScriptCreate, + esScriptDetach, + esScriptGrow, + esScriptRemove, + esScriptSetinfo, + esScriptVerify] + +esParametersFile :: String +esParametersFile = "parameters.list" -- * Reboot types @@ -681,26 +1307,748 @@ instanceRebootFull = Types.rebootTypeToRaw RebootFull rebootTypes :: FrozenSet String rebootTypes = ConstantUtils.mkSet $ map Types.rebootTypeToRaw [minBound..] +-- * Instance reboot behaviors + +instanceRebootAllowed :: String +instanceRebootAllowed = "reboot" + +instanceRebootExit :: String +instanceRebootExit = "exit" + +rebootBehaviors :: [String] +rebootBehaviors = [instanceRebootAllowed, instanceRebootExit] + -- * VTypes -vtypeBool :: String -vtypeBool = Types.vTypeToRaw VTypeBool +vtypeBool :: VType +vtypeBool = VTypeBool -vtypeInt :: String -vtypeInt = Types.vTypeToRaw VTypeInt +vtypeInt :: VType +vtypeInt = VTypeInt -vtypeMaybeString :: String -vtypeMaybeString = Types.vTypeToRaw VTypeMaybeString +vtypeMaybeString :: VType +vtypeMaybeString = VTypeMaybeString -- | Size in MiBs -vtypeSize :: String -vtypeSize = Types.vTypeToRaw VTypeSize +vtypeSize :: VType +vtypeSize = VTypeSize + +vtypeString :: VType +vtypeString = VTypeString + +enforceableTypes :: FrozenSet VType +enforceableTypes = ConstantUtils.mkSet [minBound..] + +-- | Constant representing that the user does not specify any IP version +ifaceNoIpVersionSpecified :: Int +ifaceNoIpVersionSpecified = 0 + +validSerialSpeeds :: [Int] +validSerialSpeeds = + [75, + 110, + 300, + 600, + 1200, + 1800, + 2400, + 4800, + 9600, + 14400, + 19200, + 28800, + 38400, + 57600, + 115200, + 230400, + 345600, + 460800] + +-- * HV parameter names (global namespace) + +hvAcpi :: String +hvAcpi = "acpi" + +hvBlockdevPrefix :: String +hvBlockdevPrefix = "blockdev_prefix" + +hvBootloaderArgs :: String +hvBootloaderArgs = "bootloader_args" + +hvBootloaderPath :: String +hvBootloaderPath = "bootloader_path" + +hvBootOrder :: String +hvBootOrder = "boot_order" + +hvCdromImagePath :: String +hvCdromImagePath = "cdrom_image_path" + +hvCpuCap :: String +hvCpuCap = "cpu_cap" + +hvCpuCores :: String +hvCpuCores = "cpu_cores" + +hvCpuMask :: String +hvCpuMask = "cpu_mask" + +hvCpuSockets :: String +hvCpuSockets = "cpu_sockets" + +hvCpuThreads :: String +hvCpuThreads = "cpu_threads" + +hvCpuType :: String +hvCpuType = "cpu_type" + +hvCpuWeight :: String +hvCpuWeight = "cpu_weight" + +hvDeviceModel :: String +hvDeviceModel = "device_model" + +hvDiskCache :: String +hvDiskCache = "disk_cache" + +hvDiskType :: String +hvDiskType = "disk_type" + +hvInitrdPath :: String +hvInitrdPath = "initrd_path" + +hvInitScript :: String +hvInitScript = "init_script" + +hvKernelArgs :: String +hvKernelArgs = "kernel_args" + +hvKernelPath :: String +hvKernelPath = "kernel_path" + +hvKeymap :: String +hvKeymap = "keymap" + +hvKvmCdrom2ImagePath :: String +hvKvmCdrom2ImagePath = "cdrom2_image_path" + +hvKvmCdromDiskType :: String +hvKvmCdromDiskType = "cdrom_disk_type" + +hvKvmExtra :: String +hvKvmExtra = "kvm_extra" + +hvKvmFlag :: String +hvKvmFlag = "kvm_flag" + +hvKvmFloppyImagePath :: String +hvKvmFloppyImagePath = "floppy_image_path" + +hvKvmMachineVersion :: String +hvKvmMachineVersion = "machine_version" + +hvKvmPath :: String +hvKvmPath = "kvm_path" + +hvKvmSpiceAudioCompr :: String +hvKvmSpiceAudioCompr = "spice_playback_compression" + +hvKvmSpiceBind :: String +hvKvmSpiceBind = "spice_bind" + +hvKvmSpiceIpVersion :: String +hvKvmSpiceIpVersion = "spice_ip_version" -vtypeString :: String -vtypeString = Types.vTypeToRaw VTypeString +hvKvmSpiceJpegImgCompr :: String +hvKvmSpiceJpegImgCompr = "spice_jpeg_wan_compression" -enforceableTypes :: FrozenSet String -enforceableTypes = ConstantUtils.mkSet $ map Types.vTypeToRaw [minBound..] +hvKvmSpiceLosslessImgCompr :: String +hvKvmSpiceLosslessImgCompr = "spice_image_compression" + +hvKvmSpicePasswordFile :: String +hvKvmSpicePasswordFile = "spice_password_file" + +hvKvmSpiceStreamingVideoDetection :: String +hvKvmSpiceStreamingVideoDetection = "spice_streaming_video" + +hvKvmSpiceTlsCiphers :: String +hvKvmSpiceTlsCiphers = "spice_tls_ciphers" + +hvKvmSpiceUseTls :: String +hvKvmSpiceUseTls = "spice_use_tls" + +hvKvmSpiceUseVdagent :: String +hvKvmSpiceUseVdagent = "spice_use_vdagent" + +hvKvmSpiceZlibGlzImgCompr :: String +hvKvmSpiceZlibGlzImgCompr = "spice_zlib_glz_wan_compression" + +hvKvmUseChroot :: String +hvKvmUseChroot = "use_chroot" + +hvMemPath :: String +hvMemPath = "mem_path" + +hvMigrationBandwidth :: String +hvMigrationBandwidth = "migration_bandwidth" + +hvMigrationDowntime :: String +hvMigrationDowntime = "migration_downtime" + +hvMigrationMode :: String +hvMigrationMode = "migration_mode" + +hvMigrationPort :: String +hvMigrationPort = "migration_port" + +hvNicType :: String +hvNicType = "nic_type" + +hvPae :: String +hvPae = "pae" + +hvPassthrough :: String +hvPassthrough = "pci_pass" + +hvRebootBehavior :: String +hvRebootBehavior = "reboot_behavior" + +hvRootPath :: String +hvRootPath = "root_path" + +hvSecurityDomain :: String +hvSecurityDomain = "security_domain" + +hvSecurityModel :: String +hvSecurityModel = "security_model" + +hvSerialConsole :: String +hvSerialConsole = "serial_console" + +hvSerialSpeed :: String +hvSerialSpeed = "serial_speed" + +hvSoundhw :: String +hvSoundhw = "soundhw" + +hvUsbDevices :: String +hvUsbDevices = "usb_devices" + +hvUsbMouse :: String +hvUsbMouse = "usb_mouse" + +hvUseBootloader :: String +hvUseBootloader = "use_bootloader" + +hvUseLocaltime :: String +hvUseLocaltime = "use_localtime" + +hvVga :: String +hvVga = "vga" + +hvVhostNet :: String +hvVhostNet = "vhost_net" + +hvVifScript :: String +hvVifScript = "vif_script" + +hvVifType :: String +hvVifType = "vif_type" + +hvViridian :: String +hvViridian = "viridian" + +hvVncBindAddress :: String +hvVncBindAddress = "vnc_bind_address" + +hvVncPasswordFile :: String +hvVncPasswordFile = "vnc_password_file" + +hvVncTls :: String +hvVncTls = "vnc_tls" + +hvVncX509 :: String +hvVncX509 = "vnc_x509_path" + +hvVncX509Verify :: String +hvVncX509Verify = "vnc_x509_verify" + +hvVnetHdr :: String +hvVnetHdr = "vnet_hdr" + +hvXenCmd :: String +hvXenCmd = "xen_cmd" + +hvXenCpuid :: String +hvXenCpuid = "cpuid" + +hvsParameterTitles :: Map String String +hvsParameterTitles = + Map.fromList + [(hvAcpi, "ACPI"), + (hvBootOrder, "Boot_order"), + (hvCdromImagePath, "CDROM_image_path"), + (hvCpuType, "cpu_type"), + (hvDiskType, "Disk_type"), + (hvInitrdPath, "Initrd_path"), + (hvKernelPath, "Kernel_path"), + (hvNicType, "NIC_type"), + (hvPae, "PAE"), + (hvPassthrough, "pci_pass"), + (hvVncBindAddress, "VNC_bind_address")] + +-- * Migration statuses + +hvMigrationActive :: String +hvMigrationActive = "active" + +hvMigrationCancelled :: String +hvMigrationCancelled = "cancelled" + +hvMigrationCompleted :: String +hvMigrationCompleted = "completed" + +hvMigrationFailed :: String +hvMigrationFailed = "failed" + +hvMigrationValidStatuses :: FrozenSet String +hvMigrationValidStatuses = + ConstantUtils.mkSet [hvMigrationActive, + hvMigrationCancelled, + hvMigrationCompleted, + hvMigrationFailed] + +hvMigrationFailedStatuses :: FrozenSet String +hvMigrationFailedStatuses = + ConstantUtils.mkSet [hvMigrationFailed, hvMigrationCancelled] + +-- | KVM-specific statuses +-- +-- FIXME: this constant seems unnecessary +hvKvmMigrationValidStatuses :: FrozenSet String +hvKvmMigrationValidStatuses = hvMigrationValidStatuses + +-- | Node info keys +hvNodeinfoKeyVersion :: String +hvNodeinfoKeyVersion = "hv_version" + +-- * Hypervisor state + +hvstCpuNode :: String +hvstCpuNode = "cpu_node" + +hvstCpuTotal :: String +hvstCpuTotal = "cpu_total" + +hvstMemoryHv :: String +hvstMemoryHv = "mem_hv" + +hvstMemoryNode :: String +hvstMemoryNode = "mem_node" + +hvstMemoryTotal :: String +hvstMemoryTotal = "mem_total" + +hvstsParameters :: FrozenSet String +hvstsParameters = + ConstantUtils.mkSet [hvstCpuNode, + hvstCpuTotal, + hvstMemoryHv, + hvstMemoryNode, + hvstMemoryTotal] + +hvstDefaults :: Map String Int +hvstDefaults = + Map.fromList + [(hvstCpuNode, 1), + (hvstCpuTotal, 1), + (hvstMemoryHv, 0), + (hvstMemoryTotal, 0), + (hvstMemoryNode, 0)] + +hvstsParameterTypes :: Map String VType +hvstsParameterTypes = + Map.fromList [(hvstMemoryTotal, VTypeInt), + (hvstMemoryNode, VTypeInt), + (hvstMemoryHv, VTypeInt), + (hvstCpuTotal, VTypeInt), + (hvstCpuNode, VTypeInt)] + +-- * Disk state + +dsDiskOverhead :: String +dsDiskOverhead = "disk_overhead" + +dsDiskReserved :: String +dsDiskReserved = "disk_reserved" + +dsDiskTotal :: String +dsDiskTotal = "disk_total" + +dsDefaults :: Map String Int +dsDefaults = + Map.fromList + [(dsDiskTotal, 0), + (dsDiskReserved, 0), + (dsDiskOverhead, 0)] + +dssParameterTypes :: Map String VType +dssParameterTypes = + Map.fromList [(dsDiskTotal, VTypeInt), + (dsDiskReserved, VTypeInt), + (dsDiskOverhead, VTypeInt)] + +dssParameters :: FrozenSet String +dssParameters = + ConstantUtils.mkSet [dsDiskTotal, dsDiskReserved, dsDiskOverhead] + +dsValidTypes :: FrozenSet String +dsValidTypes = ConstantUtils.mkSet [Types.diskTemplateToRaw DTPlain] + +-- Backend parameter names + +beAlwaysFailover :: String +beAlwaysFailover = "always_failover" + +beAutoBalance :: String +beAutoBalance = "auto_balance" + +beMaxmem :: String +beMaxmem = "maxmem" + +-- | Deprecated and replaced by max and min mem +beMemory :: String +beMemory = "memory" + +beMinmem :: String +beMinmem = "minmem" + +beSpindleUse :: String +beSpindleUse = "spindle_use" + +beVcpus :: String +beVcpus = "vcpus" + +besParameterTypes :: Map String VType +besParameterTypes = + Map.fromList [(beAlwaysFailover, VTypeBool), + (beAutoBalance, VTypeBool), + (beMaxmem, VTypeSize), + (beMinmem, VTypeSize), + (beSpindleUse, VTypeInt), + (beVcpus, VTypeInt)] + +besParameterTitles :: Map String String +besParameterTitles = + Map.fromList [(beAutoBalance, "Auto_balance"), + (beMinmem, "ConfigMinMem"), + (beVcpus, "ConfigVCPUs"), + (beMaxmem, "ConfigMaxMem")] + +besParameterCompat :: Map String VType +besParameterCompat = Map.insert beMemory VTypeSize besParameterTypes + +besParameters :: FrozenSet String +besParameters = + ConstantUtils.mkSet [beAlwaysFailover, + beAutoBalance, + beMaxmem, + beMinmem, + beSpindleUse, + beVcpus] + +-- | Instance specs +-- +-- FIXME: these should be associated with 'Ganeti.HTools.Types.ISpec' + +ispecMemSize :: String +ispecMemSize = ConstantUtils.ispecMemSize + +ispecCpuCount :: String +ispecCpuCount = ConstantUtils.ispecCpuCount + +ispecDiskCount :: String +ispecDiskCount = ConstantUtils.ispecDiskCount + +ispecDiskSize :: String +ispecDiskSize = ConstantUtils.ispecDiskSize + +ispecNicCount :: String +ispecNicCount = ConstantUtils.ispecNicCount + +ispecSpindleUse :: String +ispecSpindleUse = ConstantUtils.ispecSpindleUse + +ispecsParameterTypes :: Map String VType +ispecsParameterTypes = + Map.fromList + [(ConstantUtils.ispecDiskSize, VTypeInt), + (ConstantUtils.ispecCpuCount, VTypeInt), + (ConstantUtils.ispecSpindleUse, VTypeInt), + (ConstantUtils.ispecMemSize, VTypeInt), + (ConstantUtils.ispecNicCount, VTypeInt), + (ConstantUtils.ispecDiskCount, VTypeInt)] + +ispecsParameters :: FrozenSet String +ispecsParameters = + ConstantUtils.mkSet [ConstantUtils.ispecCpuCount, + ConstantUtils.ispecDiskCount, + ConstantUtils.ispecDiskSize, + ConstantUtils.ispecMemSize, + ConstantUtils.ispecNicCount, + ConstantUtils.ispecSpindleUse] + +ispecsMinmax :: String +ispecsMinmax = ConstantUtils.ispecsMinmax + +ispecsMax :: String +ispecsMax = "max" + +ispecsMin :: String +ispecsMin = "min" + +ispecsStd :: String +ispecsStd = ConstantUtils.ispecsStd + +ipolicyDts :: String +ipolicyDts = ConstantUtils.ipolicyDts + +ipolicyVcpuRatio :: String +ipolicyVcpuRatio = ConstantUtils.ipolicyVcpuRatio + +ipolicySpindleRatio :: String +ipolicySpindleRatio = ConstantUtils.ipolicySpindleRatio + +ispecsMinmaxKeys :: FrozenSet String +ispecsMinmaxKeys = ConstantUtils.mkSet [ispecsMax, ispecsMin] + +ipolicyParameters :: FrozenSet String +ipolicyParameters = + ConstantUtils.mkSet [ConstantUtils.ipolicyVcpuRatio, + ConstantUtils.ipolicySpindleRatio] + +ipolicyAllKeys :: FrozenSet String +ipolicyAllKeys = + ConstantUtils.union ipolicyParameters $ + ConstantUtils.mkSet [ConstantUtils.ipolicyDts, + ConstantUtils.ispecsMinmax, + ispecsStd] + +-- | Node parameter names + +ndExclusiveStorage :: String +ndExclusiveStorage = "exclusive_storage" + +ndOobProgram :: String +ndOobProgram = "oob_program" + +ndSpindleCount :: String +ndSpindleCount = "spindle_count" + +ndOvs :: String +ndOvs = "ovs" + +ndOvsLink :: String +ndOvsLink = "ovs_link" + +ndOvsName :: String +ndOvsName = "ovs_name" + +ndsParameterTypes :: Map String VType +ndsParameterTypes = + Map.fromList + [(ndExclusiveStorage, VTypeBool), + (ndOobProgram, VTypeString), + (ndOvs, VTypeBool), + (ndOvsLink, VTypeMaybeString), + (ndOvsName, VTypeMaybeString), + (ndSpindleCount, VTypeInt)] + +ndsParameters :: FrozenSet String +ndsParameters = ConstantUtils.mkSet (Map.keys ndsParameterTypes) + +ndsParameterTitles :: Map String String +ndsParameterTitles = + Map.fromList + [(ndExclusiveStorage, "ExclusiveStorage"), + (ndOobProgram, "OutOfBandProgram"), + (ndOvs, "OpenvSwitch"), + (ndOvsLink, "OpenvSwitchLink"), + (ndOvsName, "OpenvSwitchName"), + (ndSpindleCount, "SpindleCount")] + +-- * Logical Disks parameters + +ldpAccess :: String +ldpAccess = "access" + +ldpBarriers :: String +ldpBarriers = "disabled-barriers" + +ldpDefaultMetavg :: String +ldpDefaultMetavg = "default-metavg" + +ldpDelayTarget :: String +ldpDelayTarget = "c-delay-target" + +ldpDiskCustom :: String +ldpDiskCustom = "disk-custom" + +ldpDynamicResync :: String +ldpDynamicResync = "dynamic-resync" + +ldpFillTarget :: String +ldpFillTarget = "c-fill-target" + +ldpMaxRate :: String +ldpMaxRate = "c-max-rate" + +ldpMinRate :: String +ldpMinRate = "c-min-rate" + +ldpNetCustom :: String +ldpNetCustom = "net-custom" + +ldpNoMetaFlush :: String +ldpNoMetaFlush = "disable-meta-flush" + +ldpPlanAhead :: String +ldpPlanAhead = "c-plan-ahead" + +ldpPool :: String +ldpPool = "pool" + +ldpProtocol :: String +ldpProtocol = "protocol" + +ldpResyncRate :: String +ldpResyncRate = "resync-rate" + +ldpStripes :: String +ldpStripes = "stripes" + +diskLdTypes :: Map String VType +diskLdTypes = + Map.fromList + [(ldpAccess, VTypeString), + (ldpResyncRate, VTypeInt), + (ldpStripes, VTypeInt), + (ldpBarriers, VTypeString), + (ldpNoMetaFlush, VTypeBool), + (ldpDefaultMetavg, VTypeString), + (ldpDiskCustom, VTypeString), + (ldpNetCustom, VTypeString), + (ldpProtocol, VTypeString), + (ldpDynamicResync, VTypeBool), + (ldpPlanAhead, VTypeInt), + (ldpFillTarget, VTypeInt), + (ldpDelayTarget, VTypeInt), + (ldpMaxRate, VTypeInt), + (ldpMinRate, VTypeInt), + (ldpPool, VTypeString)] + +diskLdParameters :: FrozenSet String +diskLdParameters = ConstantUtils.mkSet (Map.keys diskLdTypes) + +-- * Disk template parameters +-- +-- Disk template parameters can be set/changed by the user via +-- gnt-cluster and gnt-group) + +drbdResyncRate :: String +drbdResyncRate = "resync-rate" + +drbdDataStripes :: String +drbdDataStripes = "data-stripes" + +drbdMetaStripes :: String +drbdMetaStripes = "meta-stripes" + +drbdDiskBarriers :: String +drbdDiskBarriers = "disk-barriers" + +drbdMetaBarriers :: String +drbdMetaBarriers = "meta-barriers" + +drbdDefaultMetavg :: String +drbdDefaultMetavg = "metavg" + +drbdDiskCustom :: String +drbdDiskCustom = "disk-custom" + +drbdNetCustom :: String +drbdNetCustom = "net-custom" + +drbdProtocol :: String +drbdProtocol = "protocol" + +drbdDynamicResync :: String +drbdDynamicResync = "dynamic-resync" + +drbdPlanAhead :: String +drbdPlanAhead = "c-plan-ahead" + +drbdFillTarget :: String +drbdFillTarget = "c-fill-target" + +drbdDelayTarget :: String +drbdDelayTarget = "c-delay-target" + +drbdMaxRate :: String +drbdMaxRate = "c-max-rate" + +drbdMinRate :: String +drbdMinRate = "c-min-rate" + +lvStripes :: String +lvStripes = "stripes" + +rbdAccess :: String +rbdAccess = "access" + +rbdPool :: String +rbdPool = "pool" + +diskDtTypes :: Map String VType +diskDtTypes = + Map.fromList [(drbdResyncRate, VTypeInt), + (drbdDataStripes, VTypeInt), + (drbdMetaStripes, VTypeInt), + (drbdDiskBarriers, VTypeString), + (drbdMetaBarriers, VTypeBool), + (drbdDefaultMetavg, VTypeString), + (drbdDiskCustom, VTypeString), + (drbdNetCustom, VTypeString), + (drbdProtocol, VTypeString), + (drbdDynamicResync, VTypeBool), + (drbdPlanAhead, VTypeInt), + (drbdFillTarget, VTypeInt), + (drbdDelayTarget, VTypeInt), + (drbdMaxRate, VTypeInt), + (drbdMinRate, VTypeInt), + (lvStripes, VTypeInt), + (rbdAccess, VTypeString), + (rbdPool, VTypeString)] + +diskDtParameters :: FrozenSet String +diskDtParameters = ConstantUtils.mkSet (Map.keys diskDtTypes) + +-- * Dynamic disk parameters + +ddpLocalIp :: String +ddpLocalIp = "local-ip" + +ddpRemoteIp :: String +ddpRemoteIp = "remote-ip" + +ddpPort :: String +ddpPort = "port" + +ddpLocalMinor :: String +ddpLocalMinor = "local-minor" + +ddpRemoteMinor :: String +ddpRemoteMinor = "remote-minor" -- * OOB supported commands @@ -748,7 +2096,11 @@ oobStatusWarning = Types.oobStatusToRaw OobStatusWarning oobStatuses :: FrozenSet String oobStatuses = ConstantUtils.mkSet $ map Types.oobStatusToRaw [minBound..] --- * NIC_* constants are used inside the ganeti config +-- | Instance Parameters Profile +ppDefault :: String +ppDefault = "default" + +-- * nic* constants are used inside the ganeti config nicLink :: String nicLink = "link" @@ -759,6 +2111,15 @@ nicMode = "mode" nicVlan :: String nicVlan = "vlan" +nicsParameterTypes :: Map String VType +nicsParameterTypes = + Map.fromList [(nicMode, vtypeString), + (nicLink, vtypeString), + (nicVlan, vtypeMaybeString)] + +nicsParameters :: FrozenSet String +nicsParameters = ConstantUtils.mkSet (Map.keys nicsParameterTypes) + nicModeBridged :: String nicModeBridged = Types.nICModeToRaw NMBridged @@ -774,6 +2135,92 @@ nicIpPool = Types.nICModeToRaw NMPool nicValidModes :: FrozenSet String nicValidModes = ConstantUtils.mkSet $ map Types.nICModeToRaw [minBound..] +releaseAction :: String +releaseAction = "release" + +reserveAction :: String +reserveAction = "reserve" + +-- * idisk* constants are used in opcodes, to create/change disks + +idiskAdopt :: String +idiskAdopt = "adopt" + +idiskMetavg :: String +idiskMetavg = "metavg" + +idiskMode :: String +idiskMode = "mode" + +idiskName :: String +idiskName = "name" + +idiskSize :: String +idiskSize = "size" + +idiskSpindles :: String +idiskSpindles = "spindles" + +idiskVg :: String +idiskVg = "vg" + +idiskProvider :: String +idiskProvider = "provider" + +idiskParamsTypes :: Map String VType +idiskParamsTypes = + Map.fromList [(idiskSize, VTypeSize), + (idiskSpindles, VTypeInt), + (idiskMode, VTypeString), + (idiskAdopt, VTypeString), + (idiskVg, VTypeString), + (idiskMetavg, VTypeString), + (idiskProvider, VTypeString), + (idiskName, VTypeMaybeString)] + +idiskParams :: FrozenSet String +idiskParams = ConstantUtils.mkSet (Map.keys idiskParamsTypes) + +-- * inic* constants are used in opcodes, to create/change nics + +inicBridge :: String +inicBridge = "bridge" + +inicIp :: String +inicIp = "ip" + +inicLink :: String +inicLink = "link" + +inicMac :: String +inicMac = "mac" + +inicMode :: String +inicMode = "mode" + +inicName :: String +inicName = "name" + +inicNetwork :: String +inicNetwork = "network" + +inicVlan :: String +inicVlan = "vlan" + +inicParamsTypes :: Map String VType +inicParamsTypes = + Map.fromList [(inicBridge, VTypeMaybeString), + (inicIp, VTypeMaybeString), + (inicLink, VTypeString), + (inicMac, VTypeString), + (inicMode, VTypeString), + (inicName, VTypeMaybeString), + (inicNetwork, VTypeMaybeString), + (inicVlan, VTypeMaybeString)] + +inicParams :: FrozenSet String +inicParams = ConstantUtils.mkSet (Map.keys inicParamsTypes) + -- * Hypervisor constants htXenPvm :: String @@ -800,6 +2247,12 @@ hyperTypes = ConstantUtils.mkSet $ map Types.hypervisorToRaw [minBound..] htsReqPort :: FrozenSet String htsReqPort = ConstantUtils.mkSet [htXenHvm, htKvm] +vncBasePort :: Int +vncBasePort = 5900 + +vncDefaultBindAddress :: String +vncDefaultBindAddress = ip4AddressAny + -- * Migration type htMigrationLive :: String @@ -1111,6 +2564,86 @@ cvAllEcodesStrings :: FrozenSet String cvAllEcodesStrings = ConstantUtils.mkSet $ map Types.cVErrorCodeToRaw [minBound..] +-- * Node verify constants + +nvBridges :: String +nvBridges = "bridges" + +nvDrbdhelper :: String +nvDrbdhelper = "drbd-helper" + +nvDrbdversion :: String +nvDrbdversion = "drbd-version" + +nvDrbdlist :: String +nvDrbdlist = "drbd-list" + +nvExclusivepvs :: String +nvExclusivepvs = "exclusive-pvs" + +nvFilelist :: String +nvFilelist = "filelist" + +nvAcceptedStoragePaths :: String +nvAcceptedStoragePaths = "allowed-file-storage-paths" + +nvFileStoragePath :: String +nvFileStoragePath = "file-storage-path" + +nvSharedFileStoragePath :: String +nvSharedFileStoragePath = "shared-file-storage-path" + +nvHvinfo :: String +nvHvinfo = "hvinfo" + +nvHvparams :: String +nvHvparams = "hvparms" + +nvHypervisor :: String +nvHypervisor = "hypervisor" + +nvInstancelist :: String +nvInstancelist = "instancelist" + +nvLvlist :: String +nvLvlist = "lvlist" + +nvMasterip :: String +nvMasterip = "master-ip" + +nvNodelist :: String +nvNodelist = "nodelist" + +nvNodenettest :: String +nvNodenettest = "node-net-test" + +nvNodesetup :: String +nvNodesetup = "nodesetup" + +nvOobPaths :: String +nvOobPaths = "oob-paths" + +nvOslist :: String +nvOslist = "oslist" + +nvPvlist :: String +nvPvlist = "pvlist" + +nvTime :: String +nvTime = "time" + +nvUserscripts :: String +nvUserscripts = "user-scripts" + +nvVersion :: String +nvVersion = "version" + +nvVglist :: String +nvVglist = "vglist" + +nvVmnodes :: String +nvVmnodes = "vmnodes" + -- * Instance status inststAdmindown :: String @@ -1174,6 +2707,14 @@ nrRegular = Types.nodeRoleToRaw NRRegular nrAll :: FrozenSet String nrAll = ConstantUtils.mkSet $ map Types.nodeRoleToRaw [minBound..] +-- * SSL certificate check constants (in days) + +sslCertExpirationError :: Int +sslCertExpirationError = 7 + +sslCertExpirationWarn :: Int +sslCertExpirationWarn = 30 + -- * Allocator framework constants iallocatorVersion :: Int @@ -1228,6 +2769,22 @@ nodeEvacAll = Types.evacModeToRaw ChangeAll nodeEvacModes :: FrozenSet String nodeEvacModes = ConstantUtils.mkSet $ map Types.evacModeToRaw [minBound..] +-- * Job queue + +jobQueueVersion :: Int +jobQueueVersion = 1 + +jobQueueSizeHardLimit :: Int +jobQueueSizeHardLimit = 5000 + +jobQueueFilesPerms :: Int +jobQueueFilesPerms = 0o640 + +-- * Unchanged job return + +jobNotchanged :: String +jobNotchanged = "nochange" + -- * Job status jobStatusQueued :: String @@ -1316,6 +2873,30 @@ opPrioSubmitValid = ConstantUtils.mkSet [opPrioLow, opPrioNormal, opPrioHigh] opPrioDefault :: Int opPrioDefault = opPrioNormal +-- * Lock recalculate mode + +locksAppend :: String +locksAppend = "append" + +locksReplace :: String +locksReplace = "replace" + +-- * Lock timeout +-- +-- The lock timeout (sum) before we transition into blocking acquire +-- (this can still be reset by priority change). Computed as max time +-- (10 hours) before we should actually go into blocking acquire, +-- given that we start from the default priority level. + +lockAttemptsMaxwait :: Double +lockAttemptsMaxwait = 15.0 + +lockAttemptsMinwait :: Double +lockAttemptsMinwait = 1.0 + +lockAttemptsTimeout :: Int +lockAttemptsTimeout = (10 * 3600) `div` (opPrioDefault - opPrioHighest) + -- * Execution log types elogMessage :: String @@ -1327,6 +2908,34 @@ elogRemoteImport = Types.eLogTypeToRaw ELogRemoteImport elogJqueueTest :: String elogJqueueTest = Types.eLogTypeToRaw ELogJqueueTest +-- * /etc/hosts modification + +etcHostsAdd :: String +etcHostsAdd = "add" + +etcHostsRemove :: String +etcHostsRemove = "remove" + +-- * Job queue test + +jqtMsgprefix :: String +jqtMsgprefix = "TESTMSG=" + +jqtExec :: String +jqtExec = "exec" + +jqtExpandnames :: String +jqtExpandnames = "expandnames" + +jqtLogmsg :: String +jqtLogmsg = "logmsg" + +jqtStartmsg :: String +jqtStartmsg = "startmsg" + +jqtAll :: FrozenSet String +jqtAll = ConstantUtils.mkSet [jqtExec, jqtExpandnames, jqtLogmsg, jqtStartmsg] + -- * Confd confdProtocolVersion :: Int @@ -1507,6 +3116,20 @@ qemuimgPath = AutoConf.qemuimgPath htools :: Bool htools = AutoConf.htools +-- * Key files for SSH daemon + +sshHostDsaPriv :: String +sshHostDsaPriv = sshConfigDir ++ "/ssh_host_dsa_key" + +sshHostDsaPub :: String +sshHostDsaPub = sshHostDsaPriv ++ ".pub" + +sshHostRsaPriv :: String +sshHostRsaPriv = sshConfigDir ++ "/ssh_host_rsa_key" + +sshHostRsaPub :: String +sshHostRsaPub = sshHostRsaPriv ++ ".pub" + -- | Path generating random UUID randomUuidFile :: String randomUuidFile = ConstantUtils.randomUuidFile