Revision 9f6dcdea Ganeti/HTools/IAlloc.hs

b/Ganeti/HTools/IAlloc.hs
53 53 
  mem <- fromObj "memory" a
54 54 
  vcpus <- fromObj "vcpus" a
55 55 
  let running = "running"
56 
  return $ (n, Instance.create n mem disk vcpus running 0 0)
56 
  return (n, Instance.create n mem disk vcpus running 0 0)
57 57 

  		





  58
  58
  
    
-- | Parses an instance as found in the cluster instance list.


  		





  59
  59
  
    
parseInstance :: NameAssoc        -- ^ The node name-to-index association list


  		





  ......




  67
  67
  
    
    pidx <- lookupNode ktn n pnode


  		





  68
  68
  
    
    let snodes = tail nodes


  		





  69
  69
  
    
    sidx <- (if null snodes then return Node.noSecondary


  		





  70
  
  
    
             else (readEitherString $ head snodes) >>= lookupNode ktn n)


  		





  
  70
  
    
             else readEitherString (head snodes) >>= lookupNode ktn n)


  		





  71
  71
  
    
    return (n, Instance.setBoth (snd base) pidx sidx)


  		





  72
  72
  
    

  		





  73
  73
  
    
-- | Parses a node as found in the cluster node list.


  		





  ......




  78
  78
  
    
    let name = n


  		





  79
  79
  
    
    offline <- fromObj "offline" a


  		





  80
  80
  
    
    drained <- fromObj "drained" a


  		





  81
  
  
    
    node <- (case offline of


  		





  82
  
  
    
               True -> return $ Node.create name 0 0 0 0 0 0 True


  		





  83
  
  
    
               _ -> do


  		





  84
  
  
    
                 mtotal <- fromObj "total_memory" a


  		





  85
  
  
    
                 mnode  <- fromObj "reserved_memory" a


  		





  86
  
  
    
                 mfree  <- fromObj "free_memory"  a


  		





  87
  
  
    
                 dtotal <- fromObj "total_disk"   a


  		





  88
  
  
    
                 dfree  <- fromObj "free_disk"    a


  		





  89
  
  
    
                 ctotal <- fromObj "total_cpus"   a


  		





  90
  
  
    
                 return $ Node.create n mtotal mnode mfree


  		





  91
  
  
    
                        dtotal dfree ctotal (offline || drained))


  		





  
  81
  
    
    node <- (if offline


  		





  
  82
  
    
             then return $ Node.create name 0 0 0 0 0 0 True


  		





  
  83
  
    
             else do


  		





  
  84
  
    
               mtotal <- fromObj "total_memory" a


  		





  
  85
  
    
               mnode  <- fromObj "reserved_memory" a


  		





  
  86
  
    
               mfree  <- fromObj "free_memory"  a


  		





  
  87
  
    
               dtotal <- fromObj "total_disk"   a


  		





  
  88
  
    
               dfree  <- fromObj "free_disk"    a


  		





  
  89
  
    
               ctotal <- fromObj "total_cpus"   a


  		





  
  90
  
    
               return $ Node.create n mtotal mnode mfree


  		





  
  91
  
    
                      dtotal dfree ctotal (offline || drained))


  		





  92
  92
  
    
    return (name, node)


  		





  93
  93
  
    

  		





  94
  94
  
    
-- | Top-level parser.


  		





  ......




  103
  103
  
    
  -- existing node parsing


  		





  104
  104
  
    
  nlist <- fromObj "nodes" obj


  		





  105
  105
  
    
  let ndata = fromJSObject nlist


  		





  106
  
  
    
  nobj <- (mapM (\(x,y) -> asJSObject y >>= parseNode x)) ndata


  		





  
  106
  
    
  nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x) ndata


  		





  107
  107
  
    
  let (ktn, nl) = assignIndices nobj


  		





  108
  108
  
    
  -- existing instance parsing


  		





  109
  109
  
    
  ilist <- fromObj "instances" obj


  		





  110
  110
  
    
  let idata = fromJSObject ilist


  		





  111
  
  
    
  iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata


  		





  
  111
  
    
  iobj <- mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x) idata


  		





  112
  112
  
    
  let (kti, il) = assignIndices iobj


  		





  113
  113
  
    
  (map_n, map_i, csf) <- mergeData (nl, il)


  		





  114
  114
  
    
  req_nodes <- fromObj "required_nodes" request


  		





  ......




  127
  127
  
    
              let ex_nodes' = map (stripSuffix $ length csf) ex_nodes


  		





  128
  128
  
    
              ex_idex <- mapM (Container.findByName map_n) ex_nodes'


  		





  129
  129
  
    
              return $ Relocate ridx req_nodes ex_idex


  		





  130
  
  
    
        other -> fail $ ("Invalid request type '" ++ other ++ "'")


  		





  
  130
  
    
        other -> fail ("Invalid request type '" ++ other ++ "'")


  		





  131
  131
  
    
  return $ Request rqtype map_n map_i csf


  		





  132
  132
  
    

  		





  133
  133
  
    
-- | Formats the response into a valid IAllocator response message.


  		












Also available in:
  Unified diff