How about this?:
(undef 'http)
(de http (S)
(use (*Post L @U @H @X)
(off *Post *Port% *ContLen *Cookies "*Cookies" "*HtSet")
(catch "http"
(in S
(cond
((not (setq L (line)))
(task (close S))
(off S)
(throw "http") )
((match '("G" "E" "T" " " "/" @U " " "H" "T" "T" "P" "/" "1"
"." @H) L)
(_htHead)
(setq *Get T)
(setq L (split @U "?"))
(for KeyVal (split (cadr L) "&")
(let Res (split KeyVal "=")
(put '*Get (pack (car Res)) (ht:Pack (cadr Res))) ) )
)
((match '("P" "O" "S" "T" " " "/" @U " " "H" "T" "T" "P" "/"
"1" "." @H) L)
(setq *Post T)
(off *MPartLim *MPartEnd)
(_htHead)
(cond
(*MPartLim (_htMultipart))
((if *ContLen (ht:Read @) (line))
(for L (split @ '&)
(when (cdr (setq L (split L "=")))
(put '*Post (pack (car L)) (ht:Pack (cadr L))) ) )
)
(T (throw "http")) ) )
(T
(out S
(if
(and
(match '(@U " " @ " " "H" "T" "T" "P" . @) L)
(member @U
(quote
("O" "P" "T" "I" "O" "N" "S")
("H" "E" "A" "D")
("P" "U" "T")
("D" "E" "L" "E" "T" "E")
("T" "R" "A" "C" "E")
("C" "O" "N" "N" "E" "C" "T") ) ) )
(httpStat 501 "Method Not Implemented" "Allow: GET,
POST")
(httpStat 400 "Bad Request") ) )
(task (close S))
(off S)
(throw "http") ) )
(out S
(cond
((= '! (car @U))
(apply (val (intern (ht:Pack (cdr @U)))) L) )
((tail '("." "l") @U)
(apply script L *Url) )
(T (httpEcho *Url "application/octet-stream" 1 T)) ) ) ) )
(and S (=0 *Http1) (task (close S))) ) )
On Thu, Jun 30, 2011 at 1:29 PM, Alexander Burger <a...@software-lab.de>wrote:
> Hi Henrik,
>
> > The goal is also to have something that can be loaded after/instead of
> > http.l when you want a simple web server without the fancy stuff.
>
> OK.
>
>
> > (redef httpHead (Typ Upd File Att)
> > (http1 Typ Upd File Att)
> > (and *Chunked (prinl "Transfer-Encoding: chunked^M"))
> > (prinl "^M") )
>
> This is basically correct, and should work, but it is not really what
> 'redef' is intended for.
>
> 'redef' redefines a function in terms of _itself_, i.e. you can use the
> original function inside the new one.
>
> For clarity, I would recommend for the above case, where a function is
> re-defined from scratch, the sequence
>
> (undef 'httpHead)
>
> (de 'httpHead ..
>
> Also, redefining 'httpHead' is probably not necessary. The difference
> is only the output of cookies, but this won't happen if no cookies are
> set.
>
>
> > (redef http (S)
>
> Concerning the contents, still more simplifications might be possible.
> Also, it seems that you based your port on a rather old version of
> "lib/http.l".
>
> So here are some points (surely not complete)
>
> > (use (*Post L @U @H @X)
> > (off *Post *ContLen *Cookies "*Cookies" "*HtSet")
> > (catch "http"
> > (in S
> > (cond
> > ((not (setq L (line)))
> > (close S)
> > (task S)
> > (off S)
> > (throw "http") )
> > ((match '("G" "E" "T" " " "/" @U " " "H" "T" "T" "P"
> > "/" "1" "." @H) L)
> > (_htHead)
> > (setq *Get T)
> > (setq L (split @U "?"))
> > (for KeyVal (split (cadr L) "&")
> > (let Res (split KeyVal "=")
> > (put '*Get (pack (car Res)) (ht:Pack (cadr Res))) )
> ) )
> > ((match '("P" "O" "S" "T" " " "/" @U " " "H" "T" "T"
> > "P" "/" "1" "." @H) L)
> > (setq *Post T)
>
> (on *Post)
>
> > (off *MPartLim *MPartEnd)
> > (_htHead)
> > (cond
> > (*MPartLim (_htMultipart))
> > ((if *ContLen (ht:Read @) (line))
> > (for L (split @ '&)
> > (when (cdr (setq L (split L "=")))
> > (put '*Post (pack (car L)) (ht:Pack (cadr L)))
> ) ) )
> > (T (throw "http")) ) )
> > (T
> > (out S
> > (if
> > (and
> > (match '(@U " " @ " " "H" "T" "T" "P" . @) L)
> > (member @U
> > (quote
> > ("O" "P" "T" "I" "O" "N" "S")
> > ("H" "E" "A" "D")
> > ("P" "U" "T")
> > ("D" "E" "L" "E" "T" "E")
> > ("T" "R" "A" "C" "E")
> > ("C" "O" "N" "N" "E" "C" "T") ) ) )
> > (httpStat 501 "Method Not Implemented" "Allow:
> > GET, POST")
> > (httpStat 400 "Bad Request") ) )
> > (close S)
> > (task S)
> > (off S)
> > (throw "http") ) )
> > (out S
> > (cond
> > ((match '("-" @X "." "h" "t" "m" "l") @U)
> > (try 'html> (extern (ht:Pack @X))) )
>
> This clause is probably not needed, as it addresses database objects which
> have a 'html>' method defined.
>
> > ((= '@ (car @U))
> > (apply (val (intern (ht:Pack (cdr @U)))) L) )
> > ((tail '("." "l") @U)
> > (apply script L *Url) )
> > ((assoc (stem @U ".") *Mimes)
> > (apply httpEcho (cdr @) *Url) )
>
> Does the '*Mimes' global exist?
>
> > ((=T (car (info *Url)))
> > (if (info (setq *Url (pack *Url "default")))
> > (apply script L *Url)
> > (http404) ) )
>
> This clause is probably also not necessary. It is used only if a directory
> should have a default script.
>
> > (T (httpEcho *Url "application/octet-stream" 1 T)) ) )
> ) )
> > (and S (=0 *Http1) (close S) (task S)) ) )
>
> Cheers,
> - Alex
> --
> UNSUBSCRIBE: mailto:picolisp@software-lab.de?subject=Unsubscribe
>
