Abstract stuffed-url
svn: r6376
This commit is contained in:
parent
18a781d6cc
commit
6305d748cf
|
@ -8,6 +8,7 @@
|
||||||
; XXX different ways to hash, different ways to store (maybe cookie?)
|
; XXX different ways to hash, different ways to store (maybe cookie?)
|
||||||
|
|
||||||
(provide stuff-url
|
(provide stuff-url
|
||||||
|
stuffed-url?
|
||||||
extend-url-query
|
extend-url-query
|
||||||
unstuff-url)
|
unstuff-url)
|
||||||
|
|
||||||
|
@ -36,6 +37,12 @@
|
||||||
(error "the url is too big: " (url->string result-uri)))
|
(error "the url is too big: " (url->string result-uri)))
|
||||||
result-uri)
|
result-uri)
|
||||||
|
|
||||||
|
(define (stuffed-url? uri)
|
||||||
|
(let* ([qry (url-query uri)]
|
||||||
|
[l-code (find-binding 'c qry)])
|
||||||
|
(and l-code
|
||||||
|
#t)))
|
||||||
|
|
||||||
(define (extend-url-query uri key val)
|
(define (extend-url-query uri key val)
|
||||||
(make-url
|
(make-url
|
||||||
(url-scheme uri)
|
(url-scheme uri)
|
||||||
|
|
|
@ -90,10 +90,8 @@
|
||||||
(or
|
(or
|
||||||
; Look in url for c=<k>
|
; Look in url for c=<k>
|
||||||
(let* ([ses (current-session)]
|
(let* ([ses (current-session)]
|
||||||
[req-url (request-uri req)]
|
[req-url (request-uri req)])
|
||||||
[qry (url-query req-url)]
|
(and (stuffed-url? req-url)
|
||||||
[l-code (find-binding 'c qry)])
|
|
||||||
(and l-code
|
|
||||||
(deserialize
|
(deserialize
|
||||||
(unstuff-url
|
(unstuff-url
|
||||||
req-url (session-url ses)
|
req-url (session-url ses)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user