[Finished cookie changes using otp and IP address jupdike@gmail.com**20080126233513] { hunk ./index.hs 16 -import OTP (otpCheck) +import OTP (otpCheck, otpCheckGeneral, otpNew) hunk ./index.hs 32 -getsecretcode environ = - case lookup "REMOTE_ADDR" environ of - Nothing -> "" - Just ipaddr -> playwith ipaddr +getNewSecretcode :: String -> IO String +getNewSecretcode ip = do + otp <- otpNew (60*60) + let result = md5 (otp ++ ip) + return result hunk ./index.hs 38 -playwith s = let { - ; hashonce = md5 s -- hash once with md5 - ; digit, digit2 :: Int - ; digit = hex2num [head hashonce] -- get numeric value of first hex digit - ; digit2 = hex2num [hashonce !! digit] -- goto index 'digit' in the string - } in hashonce --(iterate md5 hashonce) !! digit2 -- hash 'digit2' times more +getIP :: [(String,String)] -> IO String +getIP environ = do + return $ dlookup "" "REMOTE_ADDR" environ hunk ./index.hs 42 -{- let s = dlookup "" "HTTP_COOKIE" environ -} hunk ./index.hs 43 - let k = case lookup "HTTP_COOKIE" environ of - Nothing -> False - Just cookieStr -> - getKey "LoggedIn" cookieStr == getsecretcode environ -- something here is wrong? this is bad - return k + ip <- getIP environ + let cookie = case lookup "HTTP_COOKIE" environ of + Nothing -> "" + Just cookieStr -> getKey "LoggedIn" cookieStr + yn <- otpCheckGeneral cookie (\otp -> md5 (otp ++ ip)) + return yn hunk ./index.hs 88 - then let secretcode = playwith ip in - if secretcode == "" then do - let message = "Could not give your browser a cookie because \ - \this server could not uniquely identify your computer." - template False message page root file - else do - putStrLn$ "Set-Cookie: LoggedIn="++ secretcode ++"; Max-Age=360000; Version=1; Path=/" - putStr httpheader - template True "Log in successful." page root file + then --let secretcode = ip in + do secretcode <- getNewSecretcode ip --let secretcode = ip -- secretcode <- getsecretcode ip + if secretcode == "" + then do + let message = "Could not give your browser a cookie because \ + \this server could not uniquely identify your computer." + template False message page root file + else do + putStrLn$ "Set-Cookie: LoggedIn="++ secretcode ++"; Max-Age=3600; Version=1; Path=/" + putStr httpheader + template True "Log in successful." page root file }