[Cleaned up examples. bjorn@bringert.net**20060603050720] { hunk ./examples/Makefile 1 -PROGS = upload.cgi download.cgi printinput.cgi redirect.cgi multipart-extract \ - hello.cgi +PROGS = upload.cgi download.cgi printinput.cgi redirect.cgi hello.cgi + +GHCFLAGS = -package cgi -fwarn-unused-imports hunk ./examples/Makefile 10 - ghc --make -o $@ $^ - -%: %.hs - ghc --make -o $@ $^ + ghc $(GHCFLAGS) --make -o $@ $^ hunk ./examples/download.hs 1 -#!/usr/bin/env runghc - -{-# OPTIONS_GHC -package cgi #-} - --- | 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. -module Main where +-- 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. hunk ./examples/download.hs 8 -download = - do m <- getInput "file" - case m of - Just n -> do - setHeader "Content-type" "application/octet-stream" - outputFile n - Nothing -> printForm +form = concat ["
", + "
", + "", + "
"] + +sendFile f = do setHeader "Content-type" "application/octet-stream" + outputFile f hunk ./examples/download.hs 16 -printForm = - output $ "
" - ++ "
" - ++ "" - ++ "
" +cgiMain = getInput "file" >>= maybe (output form) sendFile hunk ./examples/download.hs 18 -main = runCGI download +main = runCGI cgiMain hunk ./examples/multipart-extract.hs 1 --- | This program takes a boundary string and a file name as --- the command line arguments and parses the --- contents of the file as multipart\/form-data. The bodies of --- all the message parts are printed to standard output. -module Main where - -import Network.Multipart - -import Data.ByteString.Lazy as BS - -import System.IO -import System.Environment - -readMultipart :: String -> Handle -> IO MultiPart -readMultipart b h = do inp <- BS.hGetContents h - case parseMultipartBody b inp of - Just x -> return x - Nothing -> fail "Couldn't parse input." - -savePart :: BodyPart -> IO () -savePart (BodyPart hs c) = BS.putStr c - -main :: IO () -main = do - args <- getArgs - case args of - [b] -> do - MultiPart bs <- readMultipart b stdin - mapM_ savePart bs - _ -> fail "Usage: multipart-extract < input" rmfile ./examples/multipart-extract.hs hunk ./examples/printinput.hs 1 -#!/usr/bin/env runghc - -{-# OPTIONS_GHC -package cgi #-} - --- | Prints the values of all CGI variables and inputs. -module Main where +-- Prints the values of all CGI variables and inputs. hunk ./examples/printinput.hs 5 -import Control.Monad (liftM) hunk ./examples/printinput.hs 6 -import Data.Maybe (fromJust) hunk ./examples/printinput.hs 7 -printinput :: CGI CGIResult -printinput = - do - setHeader "Content-type" "text/plain" - vs <- getVars - is <- getInputNames - i <- mapM prInput is - output ("Environment:\n" ++ prVars vs - ++ "\nInputs:\n" ++ unlines i) +cgiMain :: CGI CGIResult +cgiMain = do vs <- getVars + is <- getInputNames + i <- mapM prInput is + setHeader "Content-type" "text/plain" + output ("Environment:\n" ++ prVars vs + ++ "\nInputs:\n" ++ unlines i) hunk ./examples/printinput.hs 28 -main = runCGI printinput +main = runCGI cgiMain hunk ./examples/redirect.hs 1 -#!/usr/bin/env runghc - -{-# OPTIONS_GHC -package cgi #-} - --- | Redirect to the URL given by the url parameter. -module Main where +-- Redirect to the URL given by the url parameter. hunk ./examples/redirect.hs 5 -printinput :: CGI CGIResult -printinput = - do - murl <- getInput "url" - case murl of - Nothing -> output "url parameter not set!" - Just url -> redirect url +printinput = + getInput "url" >>= maybe (output "url parameter not set!") redirect hunk ./examples/upload.hs 1 -#!/usr/bin/env runghc - -{-# OPTIONS_GHC -package cgi #-} - --- | 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. -module Main where +-- 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. hunk ./examples/upload.hs 12 -upload = - do m <- getInputFilename "file" - case m of - Just n -> saveFile n - Nothing -> printForm +cgiMain = do m <- getInputFilename "file" + case m of + Just n -> saveFile n + Nothing -> output form hunk ./examples/upload.hs 19 - cont <- liftM fromJust (getInput "file") + cont <- liftM fromJust $ getInput "file" hunk ./examples/upload.hs 24 -printForm = - output $ "
" - ++ "
" - ++ "" - ++ "
" +form = concat ["
", + "
", + "", + "
"] hunk ./examples/upload.hs 31 - -main = runCGI upload +main = runCGI cgiMain }