module Main where

import Network.CGI
import Data.Maybe
import Data.Bits

import DB
import Process
import ByteStrHelpers
import FancyHtml

main = runCGI $ handleErrors cgiMain

cgiMain = do
    username <- getInput "username"
    let user = fromJust username
    pubkey <- liftIO $ db_firstvalue $ "SELECT pubkey FROM users WHERE username LIKE '" ++ user ++ "'"
    challenge_value <- challenge pubkey
    output $ header ++ "Please convert the following challenge to binary, sign it using your RSA key and enter the hex-encoded (':' as a delimiter between each byte optional) result in the form.<p><form action=\"login_cr.cgi\"><input type=hidden name=challenge value=" ++ challenge_value ++ "><input type=hidden name=username value=" ++ user ++ "><table><tr><td>Challenge</td><td><b>" ++ challenge_value ++ "</b></td></tr><tr><td>Signature</td><td><input type=text name=signature></td></tr><tr><td></td><td><input type=submit value=\"Get me in, now!\"</td></tr></table>" ++ (quote "The computers are never large enough or fast enough. Each breakthrough in hardware technology leads to more massive programming enterprises, new organizational principles, and an enrichment of abstract models. Every reader should ask himself periodically &raquo;Toward what end, toward what end?&laquo; &#8212; but do not ask it too often lest you pass up the fun of programming for the constipation of bittersweet philosophy." "http://www.cs.yale.edu/homes/perlis-alan/quotes.html" "Alan J. Perlis") ++ footer

challenge pubkey = do
    modulus <- liftIO $ run_with_stdin "openssl rsa -pubin -noout -modulus" pubkey    
    let keylength = (length modulus - 9) `shiftR` 1
    challenge <- liftIO $ run $ "openssl rand " ++ show (keylength - 1)
    return $ "01:" ++ byteStrToHex challenge
