LGTM, thanks
On Fri, Jan 17, 2014 at 5:28 PM, Klaus Aehlig <[email protected]> wrote: > Virtual clusters are an efficient way to test how Ganeti behaves > on a large cluster without requiring a large number of machines. > Now that more tasks like job replication are done by luxid, provide > that functionality in Haskell as well. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > Makefile.am | 3 ++- > src/Ganeti/VCluster.hs | 53 > ++++++++++++++++++++++++++++++++++++++++++++++++++ > 2 files changed, 55 insertions(+), 1 deletion(-) > create mode 100644 src/Ganeti/VCluster.hs > > diff --git a/Makefile.am b/Makefile.am > index 61e9030..bb90954 100644 > --- a/Makefile.am > +++ b/Makefile.am > @@ -745,7 +745,8 @@ HS_LIB_SRCS = \ > src/Ganeti/THH/PyType.hs \ > src/Ganeti/Types.hs \ > src/Ganeti/UDSServer.hs \ > - src/Ganeti/Utils.hs > + src/Ganeti/Utils.hs\ > + src/Ganeti/VCluster.hs > > HS_TEST_SRCS = \ > test/hs/Test/AutoConf.hs \ > diff --git a/src/Ganeti/VCluster.hs b/src/Ganeti/VCluster.hs > new file mode 100644 > index 0000000..a53ed1a > --- /dev/null > +++ b/src/Ganeti/VCluster.hs > @@ -0,0 +1,53 @@ > +{-| Utilities for virtual clusters. > + > +-} > + > +{- > + > +Copyright (C) 2014 Google Inc. > + > +This program is free software; you can redistribute it and/or modify > +it under the terms of the GNU General Public License as published by > +the Free Software Foundation; either version 2 of the License, or > +(at your option) any later version. > + > +This program is distributed in the hope that it will be useful, but > +WITHOUT ANY WARRANTY; without even the implied warranty of > +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU > +General Public License for more details. > + > +You should have received a copy of the GNU General Public License > +along with this program; if not, write to the Free Software > +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA > +02110-1301, USA. > + > +-} > + > +module Ganeti.VCluster > + ( makeVirtualPath > + ) where > + > +import Control.Monad (liftM) > +import Data.Set (member) > +import System.Posix.Env (getEnv) > +import System.FilePath.Posix > + > +import Ganeti.ConstantUtils (unFrozenSet) > +import Ganeti.Constants > + > +getRootDirectory :: IO (Maybe FilePath) > +getRootDirectory = fmap normalise `liftM` getEnv vClusterRootdirEnvname > + > +-- | Pure computation of the virtual path from the original path > +-- and the vcluster root > +virtualPath :: FilePath -> FilePath -> FilePath > +virtualPath fpath root = > + let relpath = makeRelative root fpath > + in if member fpath (unFrozenSet vClusterVpathWhitelist) > + then fpath > + else vClusterVirtPathPrefix </> relpath > + > +-- | Given a path, make it a virtual one, if in a vcluster environment. > +-- Otherwise, return unchanged. > +makeVirtualPath :: FilePath -> IO FilePath > +makeVirtualPath fpath = maybe fpath (virtualPath fpath) `liftM` > getRootDirectory > -- > 1.8.5.2 > >
