[Cleaned up examples and added some more.
bjorn@bringert.net**20060603053709] {
addfile ./examples/Makefile
addfile ./examples/download.hs
addfile ./examples/hello.hs
addfile ./examples/upload.hs
hunk ./examples/Makefile 1
-
+PROGS = upload.fcgi download.fcgi printinput.fcgi hello.fcgi # dyn-hs.cgi
+
+GHCFLAGS = -package fastcgi -fwarn-unused-imports
+
+.PHONY: all clean
+
+all: $(PROGS)
+
+%.fcgi: %.hs
+ ghc $(GHCFLAGS) --make -o $@ $^
+
+clean:
+ -rm -f *.hi *.o
+ -rm -f $(PROGS)
hunk ./examples/download.hs 1
+-- Takes server file path from the file parameter and sends
+-- that to the client.
+-- WARNING: this script is a SECURITY RISK and only for
+-- demo purposes. Do not put it on a public web server.
+
+import Network.FastCGI
+
+form = concat [""]
+
+sendFile f = do setHeader "Content-type" "application/octet-stream"
+ outputFile f
+
+cgiMain = getInput "file" >>= maybe (output form) sendFile
+
+main = runFastCGI cgiMain
hunk ./examples/dyn-hs.hs 1
-module Main where
-
-{-# OPTIONS_GHC -package fastcgi -package plugins #-}
+{-# OPTIONS_GHC -package plugins #-}
hunk ./examples/dyn-hs.hs 12
- MakeSuccess _ o -> return o
- MakeFailure e -> mapM_ putStrLn e >> fail "failed"
+ MakeSuccess _ o -> return o
+ MakeFailure e -> mapM_ putStrLn e >> fail "failed"
hunk ./examples/dyn-hs.hs 16
- LoadSuccess _ v -> return v
- _ -> fail "load failed"
+ LoadSuccess _ v -> return v
+ _ -> fail "load failed"
hunk ./examples/dyn-hs.hs 20
-
hunk ./examples/dyn-hs.hs 21
-dynMain = do
- cgi <- liftIO (loadMod "hs/DynTest.hs")
- cgi
-
+dynMain = liftIO $ loadMod "hs/DynTest.hs"
hunk ./examples/dyn-hs.hs 26
- runFastCGI dynMain
+ runFastCGI cgiMain
hunk ./examples/hello.hs 1
-
+import Network.FastCGI
+
+cgiMain = output "Hello World!"
+
+main = runFastCGI cgiMain
hunk ./examples/printinput.hs 1
-#!/usr/bin/env runghc
-
-{-# OPTIONS_GHC -package fastcgi #-}
-
--- | Prints the values of all CGI variables and inputs.
-module Main where
+-- Prints the values of all CGI variables and inputs, and some
+-- process information.
hunk ./examples/printinput.hs 13
-printinput =
- do
--- io (threadDelay 4000000)
- setHeader "Content-type" "text/plain"
- vs <- getVars
- is <- getInputNames
- i <- mapM prInput is
- pid <- liftIO getProcessID
- threadId <- liftIO myThreadId
- let tid = concat $ drop 1 $ words $ show threadId
- output ("Environment:\n" ++ prVars vs
- ++ "\nInputs:\n" ++ unlines i
- ++ "\nProcess ID: " ++ show pid
- ++ "\nThread ID: " ++ tid)
+printinput = do setHeader "Content-type" "text/plain"
+ vs <- getVars
+ is <- getInputNames
+ i <- mapM prInput is
+ pid <- liftIO getProcessID
+ threadId <- liftIO myThreadId
+ let tid = concat $ drop 1 $ words $ show threadId
+ output $ unlines ["Environment:", prVars vs,
+ "Inputs:", unlines i,
+ "Process ID: " ++ show pid,
+ "Thread ID: " ++ tid]
hunk ./examples/printinput.hs 28
-prInput i =
- do
- v <- liftM fromJust (getInput i)
- f <- getInputFilename i
- return $ case f of
- Just n -> i ++ ": File\nfilename=" ++ n
- ++ "\ncontents=" ++ v
- Nothing -> i ++ ": " ++ v
+prInput i = do v <- liftM fromJust (getInput i)
+ f <- getInputFilename i
+ return $ case f of
+ Just n -> i ++ ": File\nfilename=" ++ n
+ ++ "\ncontents=" ++ v
+ Nothing -> i ++ ": " ++ v
hunk ./examples/printinput.hs 35
---main = runFastCGIConcurrent printinput
hunk ./examples/upload.hs 1
+-- Accepts file uploads and saves the files in the given directory.
+-- WARNING: this script is a SECURITY RISK and only for
+-- demo purposes. Do not put it on a public web server.
+
+import Control.Monad (liftM)
+import Data.Maybe (fromJust)
+
+import Network.FastCGI
+
+dir = "upload"
+
+cgiMain = do m <- getInputFilename "file"
+ case m of
+ Just n -> saveFile n
+ Nothing -> output form
+
+saveFile n =
+ do
+ cont <- liftM fromJust $ getInput "file"
+ let p = dir ++ "/" ++ basename n
+ liftIO $ writeFile p cont
+ output $ "Saved as " ++ p ++ "."
+
+form = concat [""]
+
+basename = reverse . takeWhile (`notElem` "/\\") . reverse
+
+main = runFastCGI cgiMain
}