Revision 3ce8009a Ganeti/HTools/Cluster.hs

b/Ganeti/HTools/Cluster.hs
59 59
    , tryReloc
60 60
    , tryEvac
61 61
    , collapseFailures
62
    -- * Allocation functions
63
    , iterateAlloc
64
    , tieredAlloc
62 65
    ) where
63 66

  
64 67
import Data.List
......
617 620
                        ) (nl, ([], 0, [])) all_insts
618 621
      return sol
619 622

  
623
-- | Recursively place instances on the cluster until we're out of space
624
iterateAlloc :: Node.List
625
             -> Instance.List
626
             -> Instance.Instance
627
             -> Int
628
             -> [Instance.Instance]
629
             -> Result (FailStats, Node.List, [Instance.Instance])
630
iterateAlloc nl il newinst nreq ixes =
631
      let depth = length ixes
632
          newname = printf "new-%d" depth::String
633
          newidx = length (Container.elems il) + depth
634
          newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
635
      in case tryAlloc nl il newi2 nreq of
636
           Bad s -> Bad s
637
           Ok (errs, _, sols3) ->
638
               case sols3 of
639
                 [] -> Ok (collapseFailures errs, nl, ixes)
640
                 (_, (xnl, xi, _)):[] ->
641
                     iterateAlloc xnl il newinst nreq $! (xi:ixes)
642
                 _ -> Bad "Internal error: multiple solutions for single\
643
                          \ allocation"
644

  
645
tieredAlloc :: Node.List
646
            -> Instance.List
647
            -> Instance.Instance
648
            -> Int
649
            -> [Instance.Instance]
650
            -> Result (FailStats, Node.List, [Instance.Instance])
651
tieredAlloc nl il newinst nreq ixes =
652
    case iterateAlloc nl il newinst nreq ixes of
653
      Bad s -> Bad s
654
      Ok (errs, nl', ixes') ->
655
          case Instance.shrinkByType newinst . fst . last $
656
               sortBy (comparing snd) errs of
657
            Bad _ -> Ok (errs, nl', ixes')
658
            Ok newinst' ->
659
                tieredAlloc nl' il newinst' nreq ixes'
660

  
620 661
-- * Formatting functions
621 662

  
622 663
-- | Given the original and final nodes, computes the relocation description.

Also available in: Unified diff