git.iko.soy/Idris-dev
on fb3160e help sign in
Idris-dev/lib/network/cgi.idr
144 lines 3.5 kB history raw
1module network.cgi
3import system
5public
6Vars : Set
7Vars = List (String, String)
9data CGIInfo = CGISt Vars -- GET
10 Vars -- POST
11 Vars -- Cookies
12 String -- User agent
13 String -- headers
14 String -- output
16get_GET : CGIInfo -> Vars
17get_GET (CGISt g _ _ _ _ _) = g
19get_POST : CGIInfo -> Vars
20get_POST (CGISt _ p _ _ _ _) = p
22get_Cookies : CGIInfo -> Vars
23get_Cookies (CGISt _ _ c _ _ _) = c
25get_UAgent : CGIInfo -> String
26get_UAgent (CGISt _ _ _ a _ _) = a
28get_Headers : CGIInfo -> String
29get_Headers (CGISt _ _ _ _ h _) = h
31get_Output : CGIInfo -> String
32get_Output (CGISt _ _ _ _ _ o) = o
34add_Headers : String -> CGIInfo -> CGIInfo
35add_Headers str (CGISt g p c a h o) = CGISt g p c a (h ++ str) o
37add_Output : String -> CGIInfo -> CGIInfo
38add_Output str (CGISt g p c a h o) = CGISt g p c a h (o ++ str)
40abstract
41data CGI : Set -> Set where
42 MkCGI : (CGIInfo -> IO (a, CGIInfo)) -> CGI a
44getAction : CGI a -> CGIInfo -> IO (a, CGIInfo)
45getAction (MkCGI act) = act
47instance Monad CGI where {
48 (>>=) (MkCGI f) k = MkCGI (\s => do v <- f s
49 getAction (k (fst v)) (snd v))
51 return v = MkCGI (\s => return (v, s))
54setInfo : CGIInfo -> CGI ()
55setInfo i = MkCGI (\s => return ((), i))
57getInfo : CGI CGIInfo
58getInfo = MkCGI (\s => return (s, s))
60abstract
61lift : IO a -> CGI a
62lift op = MkCGI (\st => do { x <- op
63 return (x, st) } )
65abstract
66output : String -> CGI ()
67output s = do i <- getInfo
68 setInfo (add_Output s i)
70abstract
71queryVars : CGI Vars
72queryVars = do i <- getInfo
73 return (get_GET i)
75abstract
76postVars : CGI Vars
77postVars = do i <- getInfo
78 return (get_POST i)
80abstract
81cookieVars : CGI Vars
82cookieVars = do i <- getInfo
83 return (get_Cookies i)
85abstract
86queryVar : String -> CGI (Maybe String)
87queryVar x = do vs <- queryVars
88 return (lookup x vs)
90getOutput : CGI String
91getOutput = do i <- getInfo
92 return (get_Output i)
94getHeaders : CGI String
95getHeaders = do i <- getInfo
96 return (get_Headers i)
98abstract
99flushHeaders : CGI ()
100flushHeaders = do o <- getHeaders
101 lift (putStrLn o)
103abstract
104flush : CGI ()
105flush = do o <- getOutput
106 lift (putStr o)
108getVars : List Char -> String -> List (String, String)
109getVars seps query = mapMaybe readVar (split (\x => elem x seps) query)
110 where
111 readVar : String -> Maybe (String, String)
112 readVar xs with (split (\x => x == '=') xs)
113 | [k, v] = Just (trim k, trim v)
114 | _ = Nothing
116getContent : Int -> IO String
117getContent x = getC x "" where
118 getC : Int -> String -> IO String
119 getC 0 acc = return $ rev acc
120 getC n acc = do x <- getChar
121 getC (n-1) (strCons x acc)
123abstract
124runCGI : CGI a -> IO a
125runCGI prog = do
126 clen_in <- getEnv "CONTENT_LENGTH"
127 let clen = prim__strToInt clen_in
128 content <- getContent clen
129 query <- getEnv "QUERY_STRING"
130 cookie <- getEnv "HTTP_COOKIE"
131 agent <- getEnv "HTTP_USER_AGENT"
133 let get_vars = getVars ['&',';'] query
134 let post_vars = getVars ['&'] content
135 let cookies = getVars [';'] cookie
137 p <- getAction prog (CGISt get_vars post_vars cookies agent
138 "Content-type: text/html\n"
139 "")
140 putStrLn (get_Headers (snd p))
141 putStr (get_Output (snd p))
142 return (fst p)