Hi everyone.

The goal is to have a global *Get and *Post which is working in the
way I want it to work atm, the data is available in *Post, didn't try
GET yet.

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.

Maybe the cookie handling should stay as it might be wanted in more
cases than not and not adding much overhead?

This is what I have at the moment:

(redef  httpHead (Typ Upd File Att)
   (http1 Typ Upd File Att)
   (and *Chunked (prinl "Transfer-Encoding: chunked^M"))
   (prinl "^M") )

(redef http (S)
   (use (*Post L @U @H @X)
      (off *Post *ContLen *Cookies "*Cookies" "*HtSet")
      (catch "http"
         (in S
               ((not (setq L (line)))
                (close S)
                (task S)
                (off S)
                (throw "http") )
               ((match '("G" "E" "T" " " "/" @U " " "H" "T" "T" "P"
"/" "1" "." @H) L)
                (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)
                   (*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")) ) )
                  (out S
                           (match '(@U " " @ " " "H" "T" "T" "P" . @) L)
                           (member @U
                                 ("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:
                        (httpStat 400 "Bad Request") ) )
                  (close S)
                  (task S)
                  (off S)
                  (throw "http") ) )
            (out S
                  ((match '("-" @X "." "h" "t" "m" "l") @U)
                   (try 'html> (extern (ht:Pack @X))) )
                  ((= '@ (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) )
                  ((=T (car (info *Url)))
                   (if (info (setq *Url (pack *Url "default")))
                      (apply script L *Url)
                      (http404) ) )
                  (T (httpEcho *Url "application/octet-stream" 1 T)) ) ) ) )
      (and S (=0 *Http1) (close S) (task S)) ) )
UNSUBSCRIBE: mailto:picolisp@software-lab.de?subject=Unsubscribe

Reply via email to