module Main where

import Network.CGI
import Data.Maybe
import System.IO
import System.Environment

import Process
import DB
import FancyHtml

main = runCGI $ handleErrors cgiMain

cgiMain = do
    subject <- getInput "subject"
    privkey <- getInput "privkey"
    let subj = fromJust subject
    let priv = fromJust privkey
    cert <- liftIO $ db_firstvalue $ "SELECT data FROM certificates WHERE subject LIKE '" ++ subj ++ "'"
    (certfile, certhandle) <- liftIO $ openTempFile "/tmp" "cert"
    liftIO $ hPutStr certhandle cert
    liftIO $ hClose certhandle
    (keyfile, keyhandle) <- liftIO $ openTempFile "/tmp" "key"
    liftIO $ hPutStr keyhandle priv
    liftIO $ hClose keyhandle
    server_ip <- liftIO $ getEnv "SERVER_ADDR"
    signed <- liftIO $ run_with_stdin ("openssl smime -sign -signer " ++ certfile ++ " -inkey " ++ keyfile ++ " -from '" ++ subj ++ "' -to '*' -subject 'Revokation of certificate'") server_ip
    let sep = "','"
    liftIO $ db_insert $ "INSERT INTO revocation VALUES ('" ++ subj ++ sep ++ signed ++ "')"
    output $ header ++ "The certificate for " ++ subj ++ " has been revoked. Feel free to get a new one in a different name." ++ (quote "The use of anthropomorphic terminology when dealing with computing systems is a symptom of professional immaturity." "http://www.schnada.de/quotes/contempt.html" "Edsger W. Dijkstra") ++ footer
