module WASH.CGI.Debug where
import Directory
import IO
import Monad
import System
import Time
import System.IO.Unsafe
import WASH.Utility.Auxiliary
import WASH.CGI.RawCGITypes
import WASH.CGI.HTTP
import qualified WASH.Utility.Shell as Shell
import qualified WASH.Utility.ISO8601 as ISO8601
import qualified WASH.Utility.IntToString as IntToString
debugging :: Bool
debugging = False
logDirNakalele = "/export/data/thiemann"
dir :: String
dir =
unsafePerformIO $
do (ts, tps) <- timestamp
onNakalele <- doesDirectoryExist logDirNakalele
ra <- protectedGetEnv "REMOTE_ADDR" "0.0.0.0"
home <- protectedGetEnv "HOME" ""
let root | not (null home) = home ++ "/tmp"
| onNakalele = logDirNakalele
| otherwise = "/tmp"
n = root ++ "/WASHLOGA/" ++ ra ++
'/' : IntToString.intToString 10 (toEnum ts) ++
':' : IntToString.intToString 10 tps
assertDirectoryExists n (return ())
return n
timestamp :: IO (Int, Integer)
timestamp =
do clkt <- getClockTime
let dc = diffClockTimes clkt ISO8601.epochClkT
return (tdSec dc, tdPicosec dc)
withLogFile :: String -> (Handle -> IO ()) -> IO ()
withLogFile path go =
do h <- openFile path AppendMode
go h
hClose h
hPutEnvVar h val var =
do hPutStr h var
hPutChar h '='
hPutStrLn h (Shell.quote val)
hPutStr h "export "
hPutStrLn h var
makeArgList h [] =
return ()
makeArgList h (x:xs) =
do hPutStr h (Shell.quote x)
hPutChar h ' '
makeArgList h xs
makeCommand h args =
do hPutStr h "$1 "
makeArgList h args
hPutStrLn h "<< \\EOF"
makeInput h str =
do hPutStrLn h str
hPutStrLn h "\\EOF"
logInput :: CGIEnv -> IO ()
logInput cgiEnv =
when debugging $
withLogFile (dir ++ "/IN.sh") $ \ h ->
do hPutStrLn h "#!/bin/sh"
hPutEnvVar h (serverName cgiEnv) "SERVER_NAME"
hPutEnvVar h (serverPort cgiEnv) "SERVER_PORT"
hPutEnvVar h (serverSoftware cgiEnv) "SERVER_SOFTWARE"
hPutEnvVar h (serverProtocol cgiEnv) "SERVER_PROTOCOL"
hPutEnvVar h (gatewayInterface cgiEnv) "GATEWAY_INTERFACE"
hPutEnvVar h (scriptName cgiEnv) "SCRIPT_NAME"
hPutEnvVar h (show $ requestMethod cgiEnv) "REQUEST_METHOD"
hPutEnvVar h (contentLength cgiEnv) "CONTENT_LENGTH"
hPutEnvVar h (contentType cgiEnv) "CONTENT_TYPE"
hPutEnvVar h (httpCookie cgiEnv) "HTTP_COOKIE"
hPutEnvVar h (httpAccept cgiEnv) "HTTP_ACCEPT"
hPutEnvVar h (pathInfo cgiEnv) "PATH_INFO"
hPutEnvVar h (pathTranslated cgiEnv) "PATH_TRANSLATED"
hPutEnvVar h (remoteHost cgiEnv) "REMOTE_HOST"
hPutEnvVar h (remoteAddr cgiEnv) "REMOTE_ADDR"
hPutEnvVar h (remoteUser cgiEnv) "REMOTE_USER"
hPutEnvVar h (authType cgiEnv) "AUTH_TYPE"
if httpsEnabled cgiEnv
then hPutEnvVar h "on" "HTTPS"
else hPutEnvVar h "off" "HTTPS"
makeCommand h (rawArgs cgiEnv)
makeInput h (rawContents cgiEnv)
logOutput :: String -> (Handle -> IO ()) -> IO ()
logOutput name f =
let basename = dir ++ '/' : name in
when debugging $ do
before <- getClockTime
withLogFile basename f
after <- getClockTime
let dc = diffClockTimes after before
dSec = toInteger $ tdSec dc
dPic = tdPicosec dc
withLogFile (basename ++ ".time")
(\h -> do hPutStrLn h (IntToString.intToString 10 dSec)
hPutStrLn h (IntToString.intToString 10 dPic))