Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / VCluster.hs @ 13d26b66

History | View | Annotate | Download (1.6 kB)

1 4a43365c Klaus Aehlig
{-| Utilities for virtual clusters.
2 4a43365c Klaus Aehlig
3 4a43365c Klaus Aehlig
-}
4 4a43365c Klaus Aehlig
5 4a43365c Klaus Aehlig
{-
6 4a43365c Klaus Aehlig
7 4a43365c Klaus Aehlig
Copyright (C) 2014 Google Inc.
8 4a43365c Klaus Aehlig
9 4a43365c Klaus Aehlig
This program is free software; you can redistribute it and/or modify
10 4a43365c Klaus Aehlig
it under the terms of the GNU General Public License as published by
11 4a43365c Klaus Aehlig
the Free Software Foundation; either version 2 of the License, or
12 4a43365c Klaus Aehlig
(at your option) any later version.
13 4a43365c Klaus Aehlig
14 4a43365c Klaus Aehlig
This program is distributed in the hope that it will be useful, but
15 4a43365c Klaus Aehlig
WITHOUT ANY WARRANTY; without even the implied warranty of
16 4a43365c Klaus Aehlig
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 4a43365c Klaus Aehlig
General Public License for more details.
18 4a43365c Klaus Aehlig
19 4a43365c Klaus Aehlig
You should have received a copy of the GNU General Public License
20 4a43365c Klaus Aehlig
along with this program; if not, write to the Free Software
21 4a43365c Klaus Aehlig
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22 4a43365c Klaus Aehlig
02110-1301, USA.
23 4a43365c Klaus Aehlig
24 4a43365c Klaus Aehlig
-}
25 4a43365c Klaus Aehlig
26 4a43365c Klaus Aehlig
module Ganeti.VCluster
27 4a43365c Klaus Aehlig
  ( makeVirtualPath
28 4a43365c Klaus Aehlig
  ) where
29 4a43365c Klaus Aehlig
30 4a43365c Klaus Aehlig
import Control.Monad (liftM)
31 4a43365c Klaus Aehlig
import Data.Set (member)
32 4a43365c Klaus Aehlig
import System.Posix.Env (getEnv)
33 4a43365c Klaus Aehlig
import System.FilePath.Posix
34 4a43365c Klaus Aehlig
35 4a43365c Klaus Aehlig
import Ganeti.ConstantUtils (unFrozenSet)
36 4a43365c Klaus Aehlig
import Ganeti.Constants
37 4a43365c Klaus Aehlig
38 4a43365c Klaus Aehlig
getRootDirectory :: IO (Maybe FilePath)
39 4a43365c Klaus Aehlig
getRootDirectory = fmap normalise `liftM` getEnv vClusterRootdirEnvname
40 4a43365c Klaus Aehlig
41 4a43365c Klaus Aehlig
-- | Pure computation of the virtual path from the original path
42 4a43365c Klaus Aehlig
-- and the vcluster root
43 4a43365c Klaus Aehlig
virtualPath :: FilePath -> FilePath -> FilePath
44 4a43365c Klaus Aehlig
virtualPath fpath root =
45 4a43365c Klaus Aehlig
  let relpath = makeRelative root fpath
46 4a43365c Klaus Aehlig
  in if member fpath (unFrozenSet vClusterVpathWhitelist)
47 4a43365c Klaus Aehlig
       then fpath
48 4a43365c Klaus Aehlig
       else vClusterVirtPathPrefix </> relpath
49 4a43365c Klaus Aehlig
50 4a43365c Klaus Aehlig
-- | Given a path, make it a virtual one, if in a vcluster environment.
51 4a43365c Klaus Aehlig
-- Otherwise, return unchanged.
52 4a43365c Klaus Aehlig
makeVirtualPath :: FilePath -> IO FilePath
53 4a43365c Klaus Aehlig
makeVirtualPath fpath = maybe fpath (virtualPath fpath) `liftM` getRootDirectory