From 8c601c3b7a832a052f8854471552b0e71ec709e4 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 2 Dec 2013 18:17:48 -0500 Subject: Removed trailing white space from source code lines. --- kiki.hs | 220 ++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 110 insertions(+), 110 deletions(-) diff --git a/kiki.hs b/kiki.hs index bc45991..2ac6450 100644 --- a/kiki.hs +++ b/kiki.hs @@ -164,7 +164,7 @@ instance ASN1Object RSAPrivateKey where where notend (End Sequence) = False notend _ = True - privkey = RSAPrivateKey + privkey = RSAPrivateKey { rsaN = MPI n , rsaE = MPI e , rsaD = MPI d @@ -204,7 +204,7 @@ secretToPublic pkt@(SecretKeyPacket {}) = , key_algorithm = key_algorithm pkt , key = let seckey = key pkt pubs = public_key_fields (key_algorithm pkt) - in filter (\(k,v) -> k `elem` pubs) seckey + in filter (\(k,v) -> k `elem` pubs) seckey , is_subkey = is_subkey pkt , v3_days_of_validity = Nothing } @@ -309,7 +309,7 @@ verifyBindingsEx pkts = bicat . unzip $ do getBindings :: [Packet] - -> + -> ( [([Packet],[SignatureOver])] -- ^ other signatures with key sets -- that were used for the verifications , [(Word8, @@ -329,7 +329,7 @@ getBindings pkts = (sigs,bindings) i <- map signature_issuer (signatures_over b) i <- maybeToList i who <- maybeToList $ find_key fingerprint (Message keys) i - let (code,claimants) = + let (code,claimants) = case () of _ | who == topkey b -> (1,[]) _ | who == subkey b -> (2,[]) @@ -380,7 +380,7 @@ parseUID str = UserIDRecord { } where text = T.pack str - (T.strip-> realname, T.dropAround isBracket-> email) + (T.strip-> realname, T.dropAround isBracket-> email) = T.break (=='<') text (user, T.tail-> hostname) = T.break (=='@') email ( T.reverse -> topdomain, @@ -390,7 +390,7 @@ parseUID str = UserIDRecord { derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy -fpmatch grip key = +fpmatch grip key = (==) Nothing (fmap (backend (fingerprint key)) grip >>= guard . not) where @@ -404,7 +404,7 @@ listKeysFiltered grips pkts = do defaultkind (k:_) hs = k defaultkind [] hs = maybe "subkey" id - ( listToMaybe + ( listToMaybe . mapMaybe (fmap usageString . keyflags) $ hs) kinds = map (\(_,_,k,h,_)->defaultkind k h) as @@ -430,12 +430,12 @@ listKeysFiltered grips pkts = do torhash = maybe "" id $ derToBase32 <$> derRSA sub concat [ " " -- , grip top - , (if not (null claimants) - then trace ("claimants: "++show (map fingerprint claimants)) + , (if not (null claimants) + then trace ("claimants: "++show (map fingerprint claimants)) else id) ar - , formkind + , formkind , " " - , fingerprint sub + , fingerprint sub -- , " " ++ torhash , "\n" ] -- ++ ppShow hashed @@ -454,7 +454,7 @@ listKeysFiltered grips pkts = do i <- maybeToList $ signature_issuer sig_over maybeToList $ find_key (matchpr i) (Message keys) (reverse (take 16 (reverse i))) (primary,secondary) = partition (==top) issuers - + -- trace ("PRIMARY: "++show (map fingerprint primary)) $ return () -- trace ("SECONDARY: "++show (map fingerprint secondary)) $ return () guard (not (null primary)) @@ -475,7 +475,7 @@ listKeysFiltered grips pkts = do ++ map (\k -> " " ++ "^ signed: " ++ fingerprint k) secondary (_,sigs) = unzip certs "master-key " ++ fingerprint top ++ "\n" ++ uid ++" ...\n" ++ subkeys ++ "\n" - + data PGPKeyFlags = Special @@ -496,7 +496,7 @@ data PGPKeyFlags = | VouchSignEncrypt deriving (Eq,Show,Read,Enum) -usageString flgs = +usageString flgs = case flgs of Special -> "special" Vouch -> "vouch" -- signkey @@ -518,7 +518,7 @@ usageString flgs = keyflags flgs@(KeyFlagsPacket {}) = Just . toEnum $ - ( bit 0x1 certify_keys + ( bit 0x1 certify_keys .|. bit 0x2 sign_data .|. bit 0x4 encrypt_communication .|. bit 0x8 encrypt_storage ) :: Maybe PGPKeyFlags @@ -543,7 +543,7 @@ todo = error "unimplemented" -- TODO: switch to System.Environment.lookupEnv -- when linking against newer base libraries. -lookupEnv var = +lookupEnv var = handleIO_ (return Nothing) $ fmap Just (getEnv var) unmaybe def = fmap (maybe def id) @@ -574,7 +574,7 @@ lockFiles fs = do ls <- mapM dolock fs let (lks, fails) = partition (isJust . fst) ls return (map (\(lk,f)->(fromJust lk,f)) lks, map snd fails) - + unlockFiles lks = forM_ lks $ \lk -> dotlock_release lk parseOptionFile fname = do @@ -585,11 +585,11 @@ parseOptionFile fname = do return ys {- -options_from_file :: - (forall a. [String] -> Term a -> IO (Either EvalExit a)) - -> Term b - -> (String,String,Term (Maybe String)) - -> ([String],Term (Maybe String)) +options_from_file :: + (forall a. [String] -> Term a -> IO (Either EvalExit a)) + -> Term b + -> (String,String,Term (Maybe String)) + -> ([String],Term (Maybe String)) -> IO [String] options_from_file unwrapCmd term (homevar,appdir,home) (optfile_alts,options_file) = doit where @@ -606,11 +606,11 @@ options_from_file unwrapCmd term (homevar,appdir,home) (optfile_alts,options_fil doit = do args <- getArgs {- - let wants_help = + let wants_help = not . null $ filter cryForHelp args where cryForHelp "--help" = True cryForHelp "--version" = True - cryForHelp x = + cryForHelp x = and (zipWith (==) x "--help=") -} (o,h) <- do @@ -618,8 +618,8 @@ options_from_file unwrapCmd term (homevar,appdir,home) (optfile_alts,options_fil case val of Left e -> return (Nothing,Nothing) Right (o,h) -> (o,) <$> h - ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> - let optfiles = map (second ((h++"/")++)) + ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> + let optfiles = map (second ((h++"/")++)) (maybe optfile_alts' (:[]) o') optfile_alts' = zip (False:repeat True) optfile_alts o' = fmap (False,) o @@ -666,11 +666,11 @@ runChoiceWithOptionsFile (realterm,ti) choices = do q <- evalChoice as (realterm , ti) choices q where - unwrapCmd args t = + unwrapCmd args t = unwrapChoice args (realterm <:> t,ti) (map (neuter t) choices) neuter term (t,ti) = (t <:> term, ti) -data Command = +data Command = List | Autosign deriving (Eq,Show,Read,Enum) @@ -678,12 +678,12 @@ data Command = capitolizeFirstLetter (x:xs) = toUpper x : xs capitolizeFirstLetter xs = xs -instance ArgVal Command where - converter = - ( maybe (Left $ text "unknown command") Right - . fmap fst . listToMaybe . reads +instance ArgVal Command where + converter = + ( maybe (Left $ text "unknown command") Right + . fmap fst . listToMaybe . reads . capitolizeFirstLetter . map toLower - , text . map toLower . show + , text . map toLower . show ) class AutoMaybe a instance AutoMaybe Command @@ -697,7 +697,7 @@ toRight f (Right x) = Right (f x) toRight f (Left y) = Left y cmd :: Term Command -cmd = required . pos 0 Nothing $ posInfo +cmd = required . pos 0 Nothing $ posInfo { posName = "command" , posDoc = "What action to perform." } @@ -707,9 +707,9 @@ infixr 2 <:> selectAction cmd actions = actions !! fromEnum cmd -cmdInfo :: ArgVal cmd => +cmdInfo :: ArgVal cmd => cmd -> String -> Term a -> (cmd, (Term a, TermInfo)) -cmdInfo cmd doc action = +cmdInfo cmd doc action = ( cmd , ( action , defTI { termName = print cmd @@ -731,7 +731,7 @@ multiCommand :: -> [(Command, (Term a, TermInfo))] -> ( (Term a, TermInfo) , [(Term a, TermInfo)] ) -multiCommand ti choices = +multiCommand ti choices = ( ( selectAction <$> cmd <*> sequenceA (map strip choices) , ti ) , map snd choices ) @@ -763,7 +763,7 @@ readKeyFromFile False "PEM" fname = do -- putStrLn $ "rsa = "++ show rsa return . Message $ do rsa <- maybeToList rsa - return $ SecretKeyPacket + return $ SecretKeyPacket { version = 4 , timestamp = toEnum (fromEnum timestamp) , key_algorithm = RSA @@ -784,12 +784,12 @@ readKeyFromFile False "PEM" fname = do } readKeyFromFile is_public fmt filename = error ("unimplemented key type: "++fmt) -getPassphrase cmd = +getPassphrase cmd = case passphrase_fd cmd of Just fd -> do pwh <- fdToHandle (toEnum fd) fmap trimCR $ S.hGetContents pwh Nothing -> return "" - + #define HOMEOPTION (def &= explicit &= name "homedir" &= typDir ) @@ -882,14 +882,14 @@ merge db filename (Message ps) = foldl mergeit db qs mergeit :: KeyDB -> (Packet,Packet,(Packet,Map.Map FilePath Packet)) -> KeyDB mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db where - update v | isKey p && not (is_subkey p) + update v | isKey p && not (is_subkey p) = case v of Nothing -> Just $ KeyData (asMapped p) [] Map.empty Map.empty Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p]) (Map.insert filename originNil (locations key)) ) - sigs - uids + sigs + uids subkeys _ -> error . concat $ ["Unexpected master key merge error: " ,show (fingerprint top, fingerprint p)] @@ -900,8 +900,8 @@ merge db filename (Message ps) = foldl mergeit db qs update (Just (KeyData key sigs uids subkeys)) = case sub of MarkerPacket -> Just $ KeyData key (mergeSig ptt sigs) uids subkeys - UserIDPacket {} -> Just $ KeyData key - sigs + UserIDPacket {} -> Just $ KeyData key + sigs (Map.alter (mergeUidSig ptt) (uidkey sub) uids) subkeys _ | isKey sub -> Just $ KeyData key @@ -925,29 +925,29 @@ merge db filename (Message ps) = foldl mergeit db qs mergeUid p _ = error $ "Unable to merge into UID record: " ++whatP p whatP (a,_) = concat . take 1 . words . show $ a - + mergeSig :: (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust] - mergeSig sig sigs = + mergeSig sig sigs = let (xs,ys) = break (isSameSig sig) sigs first f (x,y) = (f x,y) - in if null ys + in if null ys then sigs++[first asMapped sig] - else let y:ys'=ys + else let y:ys'=ys in xs ++ (mergeSameSig sig y : ys') - - isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b = + + isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b = a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] } isSameSig (a,_) (MappedPacket b _,_) = a==b mergeSameSig :: (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap) - mergeSameSig (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b = + mergeSameSig (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b = ( MappedPacket (b { unhashed_subpackets = foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) }) (Map.insert filename originNil locs) , tb `Map.union` ta ) - + where mergeItem ys x = if x `elem` ys then ys else ys++[x] @@ -957,14 +957,14 @@ merge db filename (Message ps) = foldl mergeit db qs mergeUidSig sig Nothing = Just [asSigAndTrust sig] mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs) - mergeSubSig sig Nothing = error $ + mergeSubSig sig Nothing = error $ "Unable to merge subkey signature: "++(words (show sig) >>= take 1) flattenKeys :: Bool -> KeyDB -> Message flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db) where flattenTop (_,(KeyData key sigs uids subkeys)) = - unk key : ( concatMap flattenUid (Map.assocs uids) + unk key : ( concatMap flattenUid (Map.assocs uids) ++ concatMap flattenSub (Map.assocs subkeys)) flattenUid (str,sigs) = UserIDPacket str : concatMap unsig sigs @@ -972,13 +972,13 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs unk = (if isPublic then secretToPublic else id) . packet - unsig (sig,trustmap) = [packet sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) + unsig (sig,trustmap) = [packet sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) where f "%secring" _ = not isPublic f _ _ = isPublic prefilter = if isPublic then id else filter isSecret - where + where isSecret (_,(KeyData (MappedPacket { packet=(SecretKeyPacket {})}) _ @@ -988,7 +988,7 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs writeOutKeyrings db = return () -- TODO -data Arguments = +data Arguments = Cross_Merge { homedir :: Maybe FilePath , passphrase_fd :: Maybe Int , files :: [FilePath] @@ -999,9 +999,9 @@ data Arguments = main = do dotlock_init - args <- cmdArgs $ modes + args <- cmdArgs $ modes [ Cross_Merge HOMEOPTION - (def &= opt ("passphrase"::String) + (def &= opt ("passphrase"::String) &= typ "FD" &= (help . concat) ["file descriptor from " ,"which to read passphrase"]) @@ -1040,13 +1040,13 @@ main = do let o = Nothing h = Just homedir args = ["hi"] - ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> - let optfiles = map (second ((h++"/")++)) + ofile <- fmap listToMaybe . flip (maybe (return [])) h $ \h -> + let optfiles = map (second ((h++"/")++)) (maybe optfile_alts' (:[]) o') optfile_alts' = zip (False:repeat True) optfile_alts o' = fmap (False,) o in filterM (doesFileExist . snd) optfiles - args <- flip (maybe $ return []) ofile $ + args <- flip (maybe $ return []) ofile $ \(forgive,fname) -> parseOptionFile fname let config = map (topair . words) args where topair (x:xs) = (x,xs) @@ -1055,8 +1055,8 @@ main = do getPGPEnviron cmd = do (homedir,secring,pubring,grip) <- getHomeDir cmd (Message sec) <- readPacketsFromFile secring - let (keys,_) = partition (\k -> case k of - { SecretKeyPacket {} -> True + let (keys,_) = partition (\k -> case k of + { SecretKeyPacket {} -> True ; _ -> False }) sec return (homedir,sec, grip `mplus` fmap fingerprint (listToMaybe keys)) @@ -1068,15 +1068,15 @@ main = do let torhash = maybe "" id $ derToBase32 <$> derRSA sub return (top,(torhash,sub)) - uidScan pub = scanl (\(mkey,u) w -> + uidScan pub = scanl (\(mkey,u) w -> case () of _ | isMasterKey w -> (w,u) _ | isUserID w -> (mkey,w) - _ | otherwise -> (mkey,u) + _ | otherwise -> (mkey,u) ) (w0,w0) ws - where + where w0:ws = pub signSelfAuthTorKeys selfkey g sec grip timestamp xs = ys @@ -1102,10 +1102,10 @@ main = do then sigs {- else trace ( "key params: "++params (fromJust selfkey)++"\n" - ++traceSig (topkey new_sig) - (user_id new_sig) - (signatures_over new_sig)) - sigs + ++traceSig (topkey new_sig) + (user_id new_sig) + (signatures_over new_sig)) + sigs ++ {- map modsig -} (signatures_over new_sig) -} else sigs ++ signatures_over new_sig @@ -1160,10 +1160,10 @@ main = do flip (maybe (error "No working key?")) grip $ \grip -> do pw <- getPassphrase cmd let (pre, wk:subs) = seek_key (KeyGrip grip) sec - wkun = if symmetric_algorithm wk == Unencrypted + wkun = if symmetric_algorithm wk == Unencrypted then Just wk else do - k <- decryptSecretKey pw wk + k <- decryptSecretKey pw wk guard (symmetric_algorithm k == Unencrypted) return k flip (maybe (error "Bad passphrase?")) wkun$ \wkun -> do @@ -1177,10 +1177,10 @@ main = do marked = zipWith doit keyed pub doit (mkey,u) packet = (isTorID packet, (mkey,u,packet)) where - isTorID (UserIDPacket str) = + isTorID (UserIDPacket str) = and [ uid_topdomain parsed == "onion" , uid_realname parsed `elem` ["","Anonymous"] - , uid_user parsed == "root" + , uid_user parsed == "root" , fmap (match . fst) (lookup mkey torbindings) == Just True ] where parsed = parseUID str @@ -1195,7 +1195,7 @@ main = do timestamp <- now -- timestamp <- epochTime let xs:xss = groupBy (\_ (b,_)->not b) marked - pub' = map (snd . cleanup) xs + pub' = map (snd . cleanup) xs ++ concatMap (signSelfAuthTorKeys (Just wkun) (g::SystemRandom) sec grip timestamp) (map (map cleanup) xss) cleanup (_,(topkey,_,pkt)) = (topkey,pkt) @@ -1222,7 +1222,7 @@ main = do ) <- getPGPEnviron cmd p <- case files cmd of [] -> return sec - fs -> do + fs -> do ms <- mapM readPacketsFromFile fs let unwrap (Message ps) = ps return (concatMap unwrap ms) @@ -1333,10 +1333,10 @@ main = do flip (maybe (error "No working key?")) grip $ \grip -> do let (pre, wk:subs) = seek_key (KeyGrip grip) sec - wkun = if symmetric_algorithm wk == Unencrypted + wkun = if symmetric_algorithm wk == Unencrypted then Just wk else do - k <- decryptSecretKey pw wk + k <- decryptSecretKey pw wk guard (symmetric_algorithm k == Unencrypted) return k @@ -1365,15 +1365,15 @@ main = do torkey <- parsedkey if key_usage cmd /= "tor" then uids - else let ps = makeTorUID (g::SystemRandom) + else let ps = makeTorUID (g::SystemRandom) timestamp wkun (keyFlags wkun uids) wk torkey toruid = head ps - in if toruid `elem` uids then uids else uids ++ ps - if not (null pks) + in if toruid `elem` uids then uids else uids ++ ps + if not (null pks) then existingKey (prepk,pks) remainder wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip else newKey wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip @@ -1402,8 +1402,8 @@ existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_ (mysigs,notmines) = partition (endsWith grip . maybe "%bad%" id . signature_issuer) trailsigs endsWith big small = drop (length big - length small) big == small - vs = map (\sig -> - (sig, map (verify (Message [wk])) + vs = map (\sig -> + (sig, map (verify (Message [wk])) (signatures $ Message [wk,pk,sig]))) mysigs (verified,unverified) = partition (not . null . snd) vs @@ -1437,7 +1437,7 @@ existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_ (es,qs) = partition isExpiration ps stamp = listToMaybe . sortBy (comparing Down) $ map unwrap cs where unwrap (SignatureCreationTimePacket x) = x - exp = listToMaybe $ sort $ + exp = listToMaybe $ sort $ map unwrap es where unwrap (SignatureExpirationTimePacket x) = x expires = liftA2 (+) stamp exp if fmap ( (< timestamp) . fromIntegral) expires == Just True then do @@ -1463,15 +1463,15 @@ existingKey (prepk,pks) remainder wkun wk parsedkey tag pre uids subkeys output_ sig' = sig { hashed_subpackets = times ++ [notation] ++ qs } -- noop let sec' = pre ++ [wk] ++ uids ++ subkeys - sec' = pre - ++ [wk] - ++ uids - ++ prepk + sec' = pre + ++ [wk] + ++ uids + ++ prepk ++ [pk] - ++ signatures_over new_sig - ++ map fst vs - ++ map fst unverified - ++ notmines + ++ signatures_over new_sig + ++ map fst vs + ++ map fst unverified + ++ notmines ++ trail' ++ remainder putStrLn $ "Adding usage@="++tag @@ -1505,8 +1505,8 @@ newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do timestamp (g::SystemRandom) - hashed0 = - [ KeyFlagsPacket + hashed0 = + [ KeyFlagsPacket { certify_keys = False , sign_data = False , encrypt_communication = False @@ -1527,9 +1527,9 @@ newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do back_sig = fst $ sign (Message parsedkey) (SubkeySignature wk (head parsedkey) - (sigpackets 0x19 + (sigpackets 0x19 hashed0 - [IssuerPacket subgrip])) + [IssuerPacket subgrip])) SHA1 subgrip timestamp @@ -1554,10 +1554,10 @@ newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do -} return () - -groupBindings pub = + +groupBindings pub = let (sigs,bindings) = getBindings pub bindings' = accBindings bindings code (c,(m,s),_,_,_) = (fingerprint_material m,-c) @@ -1573,7 +1573,7 @@ isTopKey p@(PublicKeyPacket {}) | not (is_subkey p) = True isTopKey _ = False seek_key :: KeySpec -> [Packet] -> ([Packet],[Packet]) -seek_key (KeyGrip grip) sec = (pre, subs) +seek_key (KeyGrip grip) sec = (pre, subs) where (pre,subs) = break pred sec pred p@(SecretKeyPacket {}) = matchpr grip p == grip @@ -1581,24 +1581,24 @@ seek_key (KeyGrip grip) sec = (pre, subs) pred _ = False seek_key (KeyTag key tag) ps = if null bs - then (ps,[]) + then (ps,[]) else if null qs then let (as',bs') = seek_key (KeyTag key tag) (tail bs) in (as ++ (head bs:as'), bs') else (reverse (tail qs), head qs : reverse rs ++ bs) where (as,bs) = break (\p -> isSignaturePacket p - && has_tag tag p + && has_tag tag p && isJust (signature_issuer p) && matchpr (fromJust $ signature_issuer p) key == fromJust (signature_issuer p) ) ps (rs,qs) = break isKey (reverse as) - has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) + has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) seek_key (KeyUidMatch pat) ps = if null bs - then (ps,[]) + then (ps,[]) else if null qs then let (as',bs') = seek_key (KeyUidMatch pat) (tail bs) in (as ++ (head bs:as'), bs') @@ -1610,7 +1610,7 @@ seek_key (KeyUidMatch pat) ps = if null bs uidStr (UserIDPacket s) = s uidStr _ = "" - + groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps @@ -1625,7 +1625,7 @@ torsig g topk wkun uid timestamp extras = sign (Message [wkun]) (CertificationSignature (secretToPublic topk) uid - (sigpackets 0x13 + (sigpackets 0x13 subpackets subpackets_unh)) SHA1 @@ -1646,7 +1646,7 @@ torsig g topk wkun uid timestamp extras -- regex = username ++ "@" ++ hostname -- username = "[a-zA-Z0-9.][-a-zA-Z0-9.]*\\$?" :: String hostname = subdomain' pu ++ "\\." ++ topdomain' pu - pu = parseUID uidstr where UserIDPacket uidstr = uid + pu = parseUID uidstr where UserIDPacket uidstr = uid subdomain' = escape . T.unpack . uid_subdomain topdomain' = escape . T.unpack . uid_topdomain escape s = concatMap echar s @@ -1671,7 +1671,7 @@ sigpackets typ hashed unhashed = return $ SHA1 hashed unhashed - 0 -- Word16 -- Left 16 bits of the signed hash value + 0 -- Word16 -- Left 16 bits of the signed hash value [] -- [MPI] keyFlags wkun uids = keyFlags0 wkun (filter isSignaturePacket uids) @@ -1686,7 +1686,7 @@ keyFlags0 wkun uidsigs = concat , preferredhash , preferredcomp , features ] - + where subs = concatMap hashed_subpackets uidsigs keyflags = filterOr isflags subs $ -- cgit v1.2.3