diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 6ec2f9f4ae4df1cd8894896154d23cd977b01e56..13a74870c644e1026306822cbbc0f8be99a7a239 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -629,19 +629,34 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
 solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
 solutionDescription gl (groupId, result) =
   case result of
-    Ok solution -> map (printf "Group %s: %s" gname) (asLog solution)
+    Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution)
     Bad message -> [printf "Group %s: error %s" gname message]
-  where gname = Group.name $ Container.find groupId gl
+  where grp = Container.find groupId gl
+        gname = Group.name grp
+        pol = apolToString (Group.allocPolicy grp)
 
 -- | From a list of possibly bad and possibly empty solutions, filter
 -- only the groups with a valid result
-filterMGResults :: [(Gdx, Result AllocSolution)] ->
-                   [(Gdx, AllocSolution)]
-filterMGResults =
+filterMGResults :: Group.List
+                -> [(Gdx, Result AllocSolution)]
+                -> [(Gdx, AllocSolution)]
+filterMGResults gl=
+  filter ((/= AllocUnallocable) . Group.allocPolicy .
+             flip Container.find gl . fst) .
   filter (not . null . asSolutions . snd) .
   map (\(y, Ok x) -> (y, x)) .
   filter (isOk . snd)
 
+-- | Sort multigroup results based on policy and score
+sortMGResults :: Group.List
+             -> [(Gdx, AllocSolution)]
+             -> [(Gdx, AllocSolution)]
+sortMGResults gl sols =
+    let extractScore = \(_, _, _, x) -> x
+        solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
+                               (extractScore . head . asSolutions) sol)
+    in sortBy (comparing solScore) sols
+
 -- | Try to allocate an instance on a multi-group cluster.
 tryMGAlloc :: Group.List           -- ^ The group list
            -> Node.List            -- ^ The node list
@@ -656,10 +671,8 @@ tryMGAlloc mggl mgnl mgil inst cnt =
                    (gid, tryAlloc nl il inst cnt)) groups::
         [(Gdx, Result AllocSolution)]
       all_msgs = concatMap (solutionDescription mggl) sols
-      goodSols = filterMGResults sols
-      extractScore = \(_, _, _, x) -> x
-      solScore = extractScore . head . asSolutions . snd
-      sortedSols = sortBy (comparing solScore) goodSols
+      goodSols = filterMGResults mggl sols
+      sortedSols = sortMGResults mggl goodSols
   in if null sortedSols
      then Bad $ intercalate ", " all_msgs
      else let (final_group, final_sol) = head sortedSols
diff --git a/Ganeti/HTools/Types.hs b/Ganeti/HTools/Types.hs
index c86ce1eb087dc53458ff50693b7319f7f5287094..64a39c8b22c28520deaaf7774353a30e764ec70e 100644
--- a/Ganeti/HTools/Types.hs
+++ b/Ganeti/HTools/Types.hs
@@ -86,10 +86,19 @@ type Weight = Double
 type GroupID = String
 
 -- | The Group allocation policy type.
-data AllocPolicy = AllocPreferred
-                 | AllocLastResort
-                 | AllocUnallocable
-                   deriving (Show, Eq)
+--
+-- Note that the order of constructors is important as the automatic
+-- Ord instance will order them in the order they are defined, so when
+-- changing this data type be careful about the interaction with the
+-- desired sorting order.
+data AllocPolicy
+    = AllocPreferred   -- ^ This is the normal status, the group
+                       -- should be used normally during allocations
+    | AllocLastResort  -- ^ This group should be used only as
+                       -- last-resort, after the preferred groups
+    | AllocUnallocable -- ^ This group must not be used for new
+                       -- allocations
+      deriving (Show, Eq, Ord)
 
 -- | Convert a string to an alloc policy
 apolFromString :: (Monad m) => String -> m AllocPolicy