module Main where

import Network.CGI
import Data.Maybe
import Text.Regex.Posix

import Process
import DB
import ByteStrHelpers
import Session
import FancyHtml

main = runCGI $ handleErrors cgiMain

cgiMain = do
    username  <- getInput "username"
    primetext <- getInput "primes"
    let user   = fromJust username
    let primes = fromJust primetext
    pubkey <- liftIO $ db_firstvalue $ "SELECT pubkey FROM users WHERE username LIKE '" ++ user ++ "'"
    pubkey_modulus <- liftIO $ modulusFromPubKey pubkey
    let (prime1, prime2) = primesFromText primes
    if prime1 * prime2 == pubkey_modulus
        then do
            update_revocation user ((show prime1) ++ "\n" ++ (show prime2))
            output $ header ++ "Thanks for informing us of the key compromise, this key has been disabled." ++ (quote "I visualize a time when we will be to robots what dogs are to humans, and I'm rooting for the machines." "http://www.sysprog.net/quotes.html" "Claude Shannon") ++ footer
        else output $ header ++ errorBox "Incorrect factorization." ++ footer

update_revocation user info = do
    liftIO $ db_update "UPDATE users SET revocation = ? WHERE username LIKE ?" [info, user]

modulusFromPubKey pubkey = do
    mod_openssl <- run_with_stdin "openssl rsa -pubin -modulus -noout" pubkey
    return (hexStrToInt $ evenLength $ tailN 8 $ chomp mod_openssl)

primesFromText primes =
    (read $ head groups :: Integer, read $ head $ tail groups :: Integer) where
        (before, match, after, groups) = primes =~ "([0-9]+)\r?\n([0-9]+)" :: (String, String, String, [String])

tailN 1 l = tail l
tailN n l = tailN (n-1) (tail l)
