From a0529a64418799bb774ec31dbcd962443f8f5d31 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 9 Mar 2009 21:37:39 +0100
Subject: [PATCH] Beautify: strip common suffix from names

This patch automatically removes the longest common (domain, i.e.
starting with a dot) suffix from the node and instance names. This gives
a much clearer display, and this format is compatible with the way
Ganeti accepts shortened names.
---
 src/Cluster.hs |   27 +++++++++++++++++++++++++--
 src/hbal.hs    |    7 +++++--
 src/hn1.hs     |    6 +++++-
 3 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/src/Cluster.hs b/src/Cluster.hs
index 6488db7..0cc7cc4 100644
--- a/src/Cluster.hs
+++ b/src/Cluster.hs
@@ -621,6 +621,24 @@ fixNodes nl il =
                     ac3 = (pdx, pnew):(sdx, snew):ac2
                 in ac3) nl il
 
+-- | Compute the longest common suffix of a [(Int, String)] list that
+-- | starts with a dot
+longestDomain :: [(Int, String)] -> String
+longestDomain [] = ""
+longestDomain ((_,x):xs) =
+    let
+        onlyStrings = snd $ unzip xs
+    in
+      foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings
+                              then suffix
+                              else accu)
+      "" $ filter (isPrefixOf ".") (tails x)
+
+-- | Remove tails from the (Int, String) lists
+stripSuffix :: String -> [(Int, String)] -> [(Int, String)]
+stripSuffix suffix lst =
+    let sflen = length suffix in
+    map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
 
 {-| Initializer function that loads the data from a node and list file
     and massages it into the correct format. -}
@@ -628,7 +646,7 @@ loadData :: String -- ^ Node data in text format
          -> String -- ^ Instance data in text format
          -> (Container.Container Node.Node,
              Container.Container Instance.Instance,
-             [(Int, String)], [(Int, String)])
+             String, [(Int, String)], [(Int, String)])
 loadData ndata idata =
     let
     {- node file: name mem disk -}
@@ -646,5 +664,10 @@ loadData ndata idata =
         il3 = Container.fromAssocList il
         nl3 = Container.fromAssocList
              (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
+        xtn = swapPairs ktn
+        xti = swapPairs kti
+        common_suffix = longestDomain (xti ++ xtn)
+        stn = stripSuffix common_suffix xtn
+        sti = stripSuffix common_suffix xti
     in
-      (nl3, il3, swapPairs ktn, swapPairs kti)
+      (nl3, il3, common_suffix, stn, sti)
diff --git a/src/hbal.hs b/src/hbal.hs
index 5e5c00a..2491711 100644
--- a/src/hbal.hs
+++ b/src/hbal.hs
@@ -136,12 +136,15 @@ main = do
             host -> (readData getNodes host,
                      readData getInstances host)
 
-  (nl, il, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
-
+  (nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
 
   unless oneline $ printf "Loaded %d nodes, %d instances\n"
              (Container.size nl)
              (Container.size il)
+
+  when (length csf > 0 && not oneline) $ do
+         printf "Note: Stripping common suffix of '%s' from names\n" csf
+
   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
   unless oneline $ printf
              "Initial check done: %d bad nodes, %d bad instances.\n"
diff --git a/src/hn1.hs b/src/hn1.hs
index 6efbf8d..c41d8d5 100644
--- a/src/hn1.hs
+++ b/src/hn1.hs
@@ -131,11 +131,15 @@ main = do
             host -> (readData getNodes host,
                      readData getInstances host)
 
-  (nl, il, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
+  (nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
 
   printf "Loaded %d nodes, %d instances\n"
              (Container.size nl)
              (Container.size il)
+
+  when (length csf > 0) $ do
+         printf "Note: Stripping common suffix of '%s' from names\n" csf
+
   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
   printf "Initial check done: %d bad nodes, %d bad instances.\n"
              (length bad_nodes) (length bad_instances)
-- 
1.7.10.4