newlispfanclub.alh.net

Code: Select all

; get stdin POST method parameters if present
;
(set 'inline (read-line))
(if inline 
	(set 'params (get-vars inline)))
 
(if (not params) (set 'params '()))

Code: Select all

; get stdin POST method parameters if present
;
(when (= (env "HTTP_METHOD") "POST")
  (read (device) post-data (integer (env "CONTENT_LENGTH")))
  (set 'params (get-vars post-data)))

(if (not params) (set 'params '()))

Code: Select all

(define (www-not-auth)
  (println "Status: 401 Authorization required")
  (println "WWW-Authenticate: Basic realm=\"Protected\"")
  (println "Content-type: text/plain")
  (println "")
  (println "Please provide a valid username and password")
  (exit))

(unless (and (env "HTTP_AUTHORIZATION")
             (starts-with (env "HTTP_AUTHORIZATION") "basic " 1))
  (www-not-auth))

(setq login-data (parse (base64-dec ((parse (env "HTTP_AUTHORIZATION")) 1)) ":"))

; verify username available as (login-data 0) and password available as (login-data 1)
; and call (www-not-auth) if authentication fails

(env "REMOTE_USER" (login-data 0))
(env "HTTP_AUTHORIZATION" "")