Display multiple uids

1 files changed, 49 insertions, 18 deletions

diff --git a/keys.hs b/keys.hs
index c0b5baa..104e6ef 100644
--- a/keys.hs
+++ b/keys.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE ViewPatterns  #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
 import Data.Binary
@@ -12,6 +13,7 @@ import Data.OpenPGP.CryptoAPI
 import Data.Ord
 import Data.Maybe
 import Data.Bits
+import qualified Data.Text as T
 
 getPackets :: IO [Packet]
 getPackets = do
@@ -132,6 +134,35 @@ accBindings bs = as
             (bc,_,bkind,bhashed,bclaimaints)
         = (ac .|. bc,p,akind++bkind,ahashed++bhashed,aclaimaints++bclaimaints)
 
+
+data UserIDRecord = UserIDRecord {
+    uid_full :: String,
+    uid_user :: T.Text,
+    uid_subdomain :: T.Text,
+    uid_topdomain :: T.Text
+}
+
+isBracket '<' = True
+isBracket '>' = True
+isBracket _   = False
+
+parseUID str = UserIDRecord {
+                    uid_full = str,
+                    uid_user = user,
+                    uid_subdomain = subdomain,
+                    uid_topdomain = topdomain
+                }
+ where
+    text = T.pack str
+    (T.strip-> realname, T.dropAround isBracket-> email) 
+                              = T.break (=='<') text
+    (user, T.tail-> hostname) = T.break (=='@') email
+    (T.reverse-> topdomain,T.reverse-> subdomain) 
+                              = T.break (=='.') 
+                                . T.reverse $ hostname
+
+        
+
 listKeys pkts = do
     let (certs,bs) = getBindings pkts
         as = accBindings bs
@@ -158,9 +189,9 @@ listKeys pkts = do
                         2 -> " <-- "
                         3 -> " <-> "
                 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
-            " "++grip top ++ ar ++ formkind++" "++ fingerprint sub ++ "\n"
+            " " {- ++grip top -} ++ ar ++ formkind++" "++ fingerprint sub ++ "\n"
                -- ++ ppShow hashed
-        uid = maybe "" id . listToMaybe $ do
+        uid = {- maybe "" id . listToMaybe $ -} do
             (keys,sigs) <- certs
             sig <- sigs
             guard (isCertificationSig sig)
@@ -168,24 +199,12 @@ listKeys pkts = do
             sig_over <- signatures_over sig
             guard (join (fmap (find_key smallpr (Message keys)) $ signature_issuer sig_over) == Just top)
             let UserIDPacket uid = user_id sig
-            return uid
+                parsed = parseUID uid
+            " " ++ " --> " ++ "@" ++ " " ++ uid_full parsed ++ "\n"
         (_,sigs) = unzip certs
-    unlines 
-        [ uid 
-        , "master-key " ++ fingerprint top ++ "\n" ++ subkeys ]
+    "master-key " ++ fingerprint top ++ "\n" ++ uid ++ subkeys ++ "\n"
     
 
-{-
-, KeyFlagsPacket
-    { certify_keys = False
-    , sign_data = True
-    , encrypt_communication = True
-    , encrypt_storage = True
-    , split_key = False
-    , authentication = True
-    , group_key = False
-    }
--}
 data PGPKeyFlags =
     Special
     | Vouch
@@ -231,12 +250,24 @@ keyflags flgs@(KeyFlagsPacket {}) =
         .|. bit 0x2 sign_data
         .|. bit 0x4 encrypt_communication
         .|. bit 0x8 encrypt_storage )     :: Maybe PGPKeyFlags
+    -- other flags:
+    --  split_key
+    --  authentication
+    --  group_key
  where
     bit v f = if f flgs then v else 0
 keyflags _ = Nothing
 
 
+modifyUID (UserIDPacket str) = UserIDPacket str'
+ where
+    (fstname,rst) = break (==' ') str
+    str' = mod fstname ++ rst
+    mod "Bob" = "Bob Fucking"
+    mod x     = x
+modifyUID other              = other
+
 main = do
     pkts <- getPackets
-    putStrLn $ listKeys pkts
+    putStrLn $ listKeys pkts -- (map modifyUID pkts)
     return ()