Revision 8f48f67d

b/htools/Ganeti/HTools/Cluster.hs
1036 1036 
-- | Recursively place instances on the cluster until we're out of space.
1037 1037 
iterateAlloc :: Node.List
1038 1038 
             -> Instance.List
1039 
             -> Maybe Int
1039 1040 
             -> Instance.Instance
1040 1041 
             -> AllocNodes
1041 1042 
             -> [Instance.Instance]
1042 1043 
             -> [CStats]
1043 1044 
             -> Result AllocResult
1044 
iterateAlloc nl il newinst allocnodes ixes cstats =
1045 
iterateAlloc nl il limit newinst allocnodes ixes cstats =
1045 1046 
      let depth = length ixes
1046 1047 
          newname = printf "new-%d" depth::String
1047 1048 
          newidx = length (Container.elems il) + depth
1048 1049 
          newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
1050 
          newlimit = fmap (flip (-) 1) limit
1049 1051 
      in case tryAlloc nl il newi2 allocnodes of
1050 1052 
           Bad s -> Bad s
1051 1053 
           Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) ->
1054 
               let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in
1052 1055 
               case sols3 of
1053 
                 [] -> Ok (collapseFailures errs, nl, il, ixes, cstats)
1056 
                 [] -> newsol
1054 1057 
                 (xnl, xi, _, _):[] ->
1055 
                     iterateAlloc xnl (Container.add newidx xi il)
1056 
                                  newinst allocnodes (xi:ixes)
1057 
                                  (totalResources xnl:cstats)
1058 
                     if limit == Just 0
1059 
                     then newsol
1060 
                     else iterateAlloc xnl (Container.add newidx xi il)
1061 
                          newlimit newinst allocnodes (xi:ixes)
1062 
                          (totalResources xnl:cstats)
1058 1063 
                 _ -> Bad "Internal error: multiple solutions for single\
1059 1064 
                          \ allocation"
1060 1065 

  		





  1061
  1066
  
    
-- | The core of the tiered allocation mode.


  		





  1062
  1067
  
    
tieredAlloc :: Node.List


  		





  1063
  1068
  
    
            -> Instance.List


  		





  
  1069
  
    
            -> Maybe Int


  		





  1064
  1070
  
    
            -> Instance.Instance


  		





  1065
  1071
  
    
            -> AllocNodes


  		





  1066
  1072
  
    
            -> [Instance.Instance]


  		





  1067
  1073
  
    
            -> [CStats]


  		





  1068
  1074
  
    
            -> Result AllocResult


  		





  1069
  
  
    
tieredAlloc nl il newinst allocnodes ixes cstats =


  		





  1070
  
  
    
    case iterateAlloc nl il newinst allocnodes ixes cstats of


  		





  
  1075
  
    
tieredAlloc nl il limit newinst allocnodes ixes cstats =


  		





  
  1076
  
    
    case iterateAlloc nl il limit newinst allocnodes ixes cstats of


  		





  1071
  1077
  
    
      Bad s -> Bad s


  		





  1072
  1078
  
    
      Ok (errs, nl', il', ixes', cstats') ->


  		





  
  1079
  
    
          let newsol = Ok (errs, nl', il', ixes', cstats')


  		





  
  1080
  
    
              ixes_cnt = length ixes'


  		





  
  1081
  
    
              (stop, newlimit) = case limit of


  		





  
  1082
  
    
                                   Nothing -> (False, Nothing)


  		





  
  1083
  
    
                                   Just n -> (n <= ixes_cnt,


  		





  
  1084
  
    
                                              Just (n - ixes_cnt)) in


  		





  
  1085
  
    
          if stop then newsol else


  		





  1073
  1086
  
    
          case Instance.shrinkByType newinst . fst . last $


  		





  1074
  1087
  
    
               sortBy (comparing snd) errs of


  		





  1075
  
  
    
            Bad _ -> Ok (errs, nl', il', ixes', cstats')


  		





  1076
  
  
    
            Ok newinst' ->


  		





  1077
  
  
    
                tieredAlloc nl' il' newinst' allocnodes ixes' cstats'


  		





  
  1088
  
    
            Bad _ -> newsol


  		





  
  1089
  
    
            Ok newinst' -> tieredAlloc nl' il' newlimit


  		





  
  1090
  
    
                           newinst' allocnodes ixes' cstats'


  		





  1078
  1091
  
    

  		





  1079
  1092
  
    
-- | Compute the tiered spec string description from a list of


  		





  1080
  1093
  
    
-- allocated instances.


  		












  

    
      b/htools/Ganeti/HTools/QC.hs
    
  






  866
  866
  
    
        il = Container.empty


  		





  867
  867
  
    
        allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True


  		





  868
  868
  
    
    in case allocnodes >>= \allocnodes' ->


  		





  869
  
  
    
        Cluster.tieredAlloc nl il inst allocnodes' [] [] of


  		





  
  869
  
    
        Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of


  		





  870
  870
  
    
         Types.Bad _ -> False


  		





  871
  871
  
    
         Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&


  		





  872
  872
  
    
                                      IntMap.size il' == length ixes &&


  		





  ......




  909
  909
  
    
        allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True


  		





  910
  910
  
    
        i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu


  		





  911
  911
  
    
    in case allocnodes >>= \allocnodes' ->


  		





  912
  
  
    
        Cluster.iterateAlloc nl' il i_templ allocnodes' [] [] of


  		





  
  912
  
    
        Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of


  		





  913
  913
  
    
         Types.Bad _ -> False


  		





  914
  914
  
    
         Types.Ok (_, xnl, il', _, _) ->


  		





  915
  915
  
    
                   let ynl = Container.add (Node.idx hnode) hnode xnl


  		












  

    
      b/htools/hspace.hs
    
  






  302
  302
  
    
       (_, trl_nl, trl_il, trl_ixes, _) <-


  		





  303
  303
  
    
           if stop_allocation


  		





  304
  304
  
    
           then return result_noalloc


  		





  305
  
  
    
           else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)


  		





  
  305
  
    
           else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)


  		





  306
  306
  
    
                                  allocnodes [] [])


  		





  307
  307
  
    
       let spec_map' = Cluster.tieredSpecMap trl_ixes


  		





  308
  308
  
    

  		





  ......




  324
  324
  
    
  (ereason, fin_nl, fin_il, ixes, _) <-


  		





  325
  325
  
    
      if stop_allocation


  		





  326
  326
  
    
      then return result_noalloc


  		





  327
  
  
    
      else exitifbad (Cluster.iterateAlloc nl il reqinst allocnodes [] [])


  		





  
  327
  
    
      else exitifbad (Cluster.iterateAlloc nl il Nothing


  		





  
  328
  
    
                      reqinst allocnodes [] [])


  		





  328
  329
  
    

  		





  329
  330
  
    
  let allocs = length ixes


  		





  330
  331
  
    
      sreason = reverse $ sortBy (comparing snd) ereason


  		












Also available in:
  Unified diff