Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

137 lines (114 sloc) 4.419 kb
;; @module Request
;; @author Jeff Ober <jeffober@gmail.com>, Kanen Flowers <kanendosei@gmail.com>
;; @version 1.1
;; @location http://static.artfulcode.net/newlisp/request.lsp
;; @package http://static.artfulcode.net/newlisp/request.qwerty
;; @description Request module to replace input functions in the standard CGI module (updated for newlisp 10)
;; 'Request' encapsulates the processing of CGI environmental variables in
;; a different manner than the standard CGI library. POST and GET variables
;; are separated, and the url is parsed into a list of segments in order to
;; make use with .htaccess files and mod_rewrite simpler.
;;
;; POST data can only be read once, after which it becomes unavailable
;; to future parts of the program. Should the default cgi.lsp module precede
;; this module, POST data will be unavailable through the Request class. If
;; cgi.lsp is loaded after this module, POST data is unavailable to it.
;;
;; This module does not include output functions, including setting cookies.
;; Output is a function of the Response class.
;; <h4>Version history</h4>
;; <b>1.1</b>
;; &bull; fixed incompatibilites with newlisp 10
;;
;; <b>1.0</b>
;; &bull; initial release
(constant '*max-post-length* 4096)
(global '*max-post-length*)
(context 'Request)
(setq _cgi-keys '("REDIRECT_STATUS" "HTTP_HOST" "HTTP_USER_AGENT" "HTTP_ACCEPT"
"HTTP_ACCEPT_LANGUAGE" "HTTP_ACCEPT_ENCODING" "HTTP_ACCEPT_CHARSET"
"HTTP_KEEP_ALIVE" "HTTP_CONNECTION" "HTTP_COOKIE" "HTTP_CACHE_CONTROL" "PATH"
"SERVER_SIGNATURE" "SERVER_SOFTWARE" "SERVER_NAME" "SERVER_ADDR" "SERVER_PORT"
"REMOTE_ADDR" "DOCUMENT_ROOT" "SERVER_ADMIN" "SCRIPT_FILENAME" "REMOTE_PORT"
"REDIRECT_URL" "GATEWAY_INTERFACE" "SERVER_PROTOCOL" "REQUEST_METHOD"
"QUERY_STRING" "REQUEST_URI" "SCRIPT_NAME" "PATH_INFO" "PATH_TRANSLATED"))
;;; set cleaned CGI environment parameters
(setq _cgi-env (map (fn (key) (list key (trim (string (env key))))) _cgi-keys))
;;; set default method
(setq _method "get")
(define (parse-query query-string)
(let ((params '()))
(dolist (element (parse query-string "&"))
(let ((pair (parse element "=")))
(if (= 1 (length pair)) (push nil pair -1))
(push pair params -1)))
params))
;;; deal with GET params from QUERY_STRING
(setq _get (parse-query (lookup "QUERY_STRING" _cgi-env)))
;;; deal with POST params from stdin data
(read-buffer (device) post-data *max-post-length*)
(setq _post '())
(when post-data
(setq _method "post")
(setq _post (parse-query post-data)))
;;; deal with HTTP_COOKIE data
(setq _cookies '())
(dolist (element (parse (lookup "HTTP_COOKIE" _cgi-env) ";"))
(let ((pair (parse element "=")))
(push pair _cookies -1)))
;;; store segment information
(setq _segments (parse (trim (lookup "REQUEST_URI" _cgi-env) "/") "/"))
;; @syntax (Request:method)
;; @return string
;; <p>Returns the request method.</p>
(define (method)
_method)
;; @syntax (Request:get?)
;; @return boolean
;; <p>Predicates that the request method is GET.</p>
(define (get?)
(= _method "get"))
;; @syntax (Request:post?)
;; @return boolean
;; <p>Predicates that the request method is POST.</p>
(define (post?)
(= _method "post"))
;; @syntax (Request:get <str-key>)
;; @param <str-key> a GET variable
;; <p>Fetches a GET variable from the query string.</p>
(define (get key)
(if key
(lookup key _get)
_get))
;; @syntax (Request:post <str-key>)
;; @param <str-key> a POST variable
;; <p>Fetches a POST variable from the request content.</p>
(define (post key)
(if key
(lookup key _post)
_post))
;; @syntax (Request:cookies <str-key>)
;; @param <str-key> a COOKIE variable
;; <p>Fetches the value of a cookie.</p>
(define (cookies key)
(if key
(lookup key _cookies)
_cookies))
;; @syntax (Request:cookie? <str-key>)
;; @param <str-key> a COOKIE variable
;; <p>Predicates that a COOKIE variable is set.</p>
(define (cookie? key)
(lookup key _cookies))
(setq _current-segment -1)
(define (segment)
(unless (>= _current-segment (- (length _segments) 1))
(nth (if (args) (args 0) (inc '_current-segment)) _segments)))
;; @syntax (Request:segments)
;; @return list
;; <p>Returns a list of each part of the query path, e.g.
;; /foo/bar/baz becomes '("foo" "bar" "baz")'.</p>
(define (segments)
_segments)
(setq path (lookup "REQUEST_URI" _cgi-env))
(setq domain (lookup "HTTP_HOST" _cgi-env))
(context MAIN)
Jump to Line
Something went wrong with that request. Please try again.