Some password hashing schemes will also perform a number of iterations to 
increase the attack time needed. (For instance, hashing 1024 times would 
increase the strength of the password against brute force by 10 bits.) Usually 
the iterations are stored unencrypted with the hash and salt so that the 
iterations can be changed as app needs do.

There's even an RFC on the subject:
http://www.ietf.org/rfc/rfc2898.txt (PBKDF2 is the function)

-Michael

-----Original Message-----
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of Thomas Hartman
Sent: Tuesday, November 25, 2008 8:38 AM
To: Bulat Ziganshin; haskell-cafe; HAppS
Subject: Re: Re[2]: [Haskell-cafe] Password hashing

What does haskell cafe think of the following module for drop-in
password hasing for webapps? Seem reasonable?

import Data.Digest.SHA512 (hash)
import qualified Data.ByteString as B'
import qualified Data.ByteString.Char8 as B

-- store passwords as md5 hash, as a security measure
scramblepass :: String -> IO String
scramblepass p = do
  etSalt <- try $ readFile "secure/salt"
  case etSalt of
    Left e -> fail errmsg
    Right s -> -- return . show . md5 . L.pack $ p ++ s
               return . B.unpack . B'.pack . hash . B'.unpack . B.pack $ p ++ s
  where errmsg = "scramblepass error, you probably need to create a
salt file in secure/salt. This is used for \
            \hashing passwords, so keep it secure. chmod u=r
secure/salt, and make sure it's skipped \
            \in version control commits, etc. A good way to generate a
salt file is (e.g., on ubuntu) \
            \writeFile \"secure/salt\" =<< ( strongsalt $ readFile
\"/dev/urandom\")\
            \You could also just type some random seeming text into
this file, though that's not quite as secure.\
            \Keep a backup copy of this file somewhere safe in case of
disaster."


-- | eg, on ubuntu: strongsalt $ readFile "/dev/urandom"
strongsalt :: IO String -> IO String
strongsalt randomSource = return . salt' =<< randomSource
  where salt' = show . fst . next . mkStdGen . read . concat . map
(show . ord) . take 10



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to