Fix CVS crap
original commit: cc9a1fe584a421095441c48197ad18bb0dae06b7
This commit is contained in:
parent
9c29860de8
commit
a06af27c72
|
@ -2,7 +2,7 @@
|
||||||
;;; <uri-codec-unit.ss> ---- En/Decode URLs and form-urlencoded data
|
;;; <uri-codec-unit.ss> ---- En/Decode URLs and form-urlencoded data
|
||||||
;;; Time-stamp: <03/04/25 10:31:31 noel>
|
;;; Time-stamp: <03/04/25 10:31:31 noel>
|
||||||
;;;
|
;;;
|
||||||
;;; Copyright (C) 2002 by Noel Welsh.
|
;;; Copyright (C) 2002 by Noel Welsh.
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of Net.
|
;;; This file is part of Net.
|
||||||
|
|
||||||
|
@ -70,29 +70,30 @@
|
||||||
;; sample provided by Eli Barzilay
|
;; sample provided by Eli Barzilay
|
||||||
|
|
||||||
(module uri-codec-unit mzscheme
|
(module uri-codec-unit mzscheme
|
||||||
|
|
||||||
(require (lib "unitsig.ss")
|
(require (lib "unitsig.ss")
|
||||||
(lib "match.ss")
|
(lib "match.ss")
|
||||||
|
(lib "string.ss")
|
||||||
"uri-codec-sig.ss")
|
"uri-codec-sig.ss")
|
||||||
|
|
||||||
(provide uri-codec@)
|
(provide uri-codec@)
|
||||||
|
|
||||||
;; Macro to loop over integers from n (inclusive) to m (exclusive)
|
;; Macro to loop over integers from n (inclusive) to m (exclusive)
|
||||||
;; Extracted from iteration.ss in macro package at Schematics
|
;; Extracted from iteration.ss in macro package at Schematics
|
||||||
(define-syntax for
|
(define-syntax for
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((for (i n m) forms ...)
|
((for (i n m) forms ...)
|
||||||
(let ((fixed-m m))
|
(let ((fixed-m m))
|
||||||
(let loop ((i n))
|
(let loop ((i n))
|
||||||
(if (< i fixed-m)
|
(if (< i fixed-m)
|
||||||
(begin
|
(begin
|
||||||
forms ...
|
forms ...
|
||||||
(loop (+ i 1)))))))))
|
(loop (+ i 1)))))))))
|
||||||
|
|
||||||
(define uri-codec@
|
(define uri-codec@
|
||||||
(unit/sig net:uri-codec^
|
(unit/sig net:uri-codec^
|
||||||
(import)
|
(import)
|
||||||
|
|
||||||
;; The characters that always map to themselves
|
;; The characters that always map to themselves
|
||||||
(define alphanumeric-mapping
|
(define alphanumeric-mapping
|
||||||
(map (lambda (char)
|
(map (lambda (char)
|
||||||
|
@ -104,16 +105,16 @@
|
||||||
#\e #\f #\g #\h #\i #\j #\k #\l #\m #\n
|
#\e #\f #\g #\h #\i #\j #\k #\l #\m #\n
|
||||||
#\o #\p #\q #\r #\s #\t #\u #\v #\w #\x
|
#\o #\p #\q #\r #\s #\t #\u #\v #\w #\x
|
||||||
#\y #\z)))
|
#\y #\z)))
|
||||||
|
|
||||||
;; Characters that sometimes map to themselves
|
;; Characters that sometimes map to themselves
|
||||||
(define safe-mapping
|
(define safe-mapping
|
||||||
(map (lambda (char)
|
(map (lambda (char)
|
||||||
(cons char char))
|
(cons char char))
|
||||||
'(#\- #\_ #\. #\! #\~ #\* #\' #\( #\))))
|
'(#\- #\_ #\. #\! #\~ #\* #\' #\( #\))))
|
||||||
|
|
||||||
;; The strict URI mapping
|
;; The strict URI mapping
|
||||||
(define uri-mapping
|
(define uri-mapping
|
||||||
(append alphanumeric-mapping safe-mapping))
|
(append alphanumeric-mapping safe-mapping))
|
||||||
|
|
||||||
;; The form-urlencoded mapping
|
;; The form-urlencoded mapping
|
||||||
(define form-urlencoded-mapping
|
(define form-urlencoded-mapping
|
||||||
|
@ -123,17 +124,17 @@
|
||||||
(#\_ . #\_)
|
(#\_ . #\_)
|
||||||
(#\space . #\+))
|
(#\space . #\+))
|
||||||
alphanumeric-mapping))
|
alphanumeric-mapping))
|
||||||
|
|
||||||
(define (number->hex-string number)
|
(define (number->hex-string number)
|
||||||
(let ((hex (number->string number 16)))
|
(let ((hex (number->string number 16)))
|
||||||
(string-append "%"
|
(string-append "%"
|
||||||
(if (= (string-length hex) 1)
|
(if (= (string-length hex) 1)
|
||||||
(string-append "0" hex)
|
(string-append "0" hex)
|
||||||
hex))))
|
hex))))
|
||||||
|
|
||||||
(define (hex-string->number hex-string)
|
(define (hex-string->number hex-string)
|
||||||
(string->number (substring hex-string 1 3) 16))
|
(string->number (substring hex-string 1 3) 16))
|
||||||
|
|
||||||
;; (listof (cons char char)) -> (values (vectorof string) (vectorof string))
|
;; (listof (cons char char)) -> (values (vectorof string) (vectorof string))
|
||||||
(define (make-codec-tables alist)
|
(define (make-codec-tables alist)
|
||||||
(let ((encoding-table (make-vector 256 ""))
|
(let ((encoding-table (make-vector 256 ""))
|
||||||
|
@ -151,17 +152,17 @@
|
||||||
(string orig))])
|
(string orig))])
|
||||||
alist)
|
alist)
|
||||||
(values encoding-table decoding-table)))
|
(values encoding-table decoding-table)))
|
||||||
|
|
||||||
(define-values (uri-encoding-vector uri-decoding-vector)
|
(define-values (uri-encoding-vector uri-decoding-vector)
|
||||||
(make-codec-tables uri-mapping))
|
(make-codec-tables uri-mapping))
|
||||||
|
|
||||||
(define-values (form-urlencoded-encoding-vector
|
(define-values (form-urlencoded-encoding-vector
|
||||||
form-urlencoded-decoding-vector)
|
form-urlencoded-decoding-vector)
|
||||||
(make-codec-tables form-urlencoded-mapping))
|
(make-codec-tables form-urlencoded-mapping))
|
||||||
|
|
||||||
;; vector string -> string
|
;; vector string -> string
|
||||||
(define (encode table str)
|
(define (encode table str)
|
||||||
(apply string-append
|
(apply string-append
|
||||||
(map (lambda (char)
|
(map (lambda (char)
|
||||||
(vector-ref table (char->integer char)))
|
(vector-ref table (char->integer char)))
|
||||||
(string->list str))))
|
(string->list str))))
|
||||||
|
@ -172,7 +173,7 @@
|
||||||
(match-lambda
|
(match-lambda
|
||||||
[() (list)]
|
[() (list)]
|
||||||
[(#\% char1 char2 . rest)
|
[(#\% char1 char2 . rest)
|
||||||
(cons
|
(cons
|
||||||
(vector-ref table
|
(vector-ref table
|
||||||
(string->number (string char1 char2) 16))
|
(string->number (string char1 char2) 16))
|
||||||
(internal-decode rest))]
|
(internal-decode rest))]
|
||||||
|
@ -187,14 +188,14 @@
|
||||||
(define (uri-encode str)
|
(define (uri-encode str)
|
||||||
(encode uri-encoding-vector str))
|
(encode uri-encoding-vector str))
|
||||||
|
|
||||||
;; string -> string
|
;; string -> string
|
||||||
(define (uri-decode str)
|
(define (uri-decode str)
|
||||||
(decode uri-decoding-vector str))
|
(decode uri-decoding-vector str))
|
||||||
|
|
||||||
;; string -> string
|
;; string -> string
|
||||||
(define (form-urlencoded-encode str)
|
(define (form-urlencoded-encode str)
|
||||||
(encode form-urlencoded-encoding-vector str))
|
(encode form-urlencoded-encoding-vector str))
|
||||||
|
|
||||||
;; string -> string
|
;; string -> string
|
||||||
(define (form-urlencoded-decode str)
|
(define (form-urlencoded-decode str)
|
||||||
(decode form-urlencoded-decoding-vector str))
|
(decode form-urlencoded-decoding-vector str))
|
||||||
|
@ -225,7 +226,9 @@
|
||||||
#f
|
#f
|
||||||
(match (regexp-match-positions key-regexp str start)
|
(match (regexp-match-positions key-regexp str start)
|
||||||
[((start . end))
|
[((start . end))
|
||||||
(vector (form-urlencoded-decode (substring str start end))
|
(vector (let ([s (form-urlencoded-decode (substring str start end))])
|
||||||
|
(string-lowercase! s)
|
||||||
|
(string->symbol s))
|
||||||
(add1 end))]
|
(add1 end))]
|
||||||
[#f #f])))
|
[#f #f])))
|
||||||
(define (next-value str start)
|
(define (next-value str start)
|
||||||
|
@ -245,17 +248,17 @@
|
||||||
[#f
|
[#f
|
||||||
(vector (cons key "") (string-length str))])]
|
(vector (cons key "") (string-length str))])]
|
||||||
[#f #f]))
|
[#f #f]))
|
||||||
(let loop ((start 0)
|
(let loop ([start 0]
|
||||||
(end (string-length str))
|
[end (string-length str)]
|
||||||
(alist '()))
|
[make-alist (lambda (x) x)])
|
||||||
(cond
|
(cond
|
||||||
[(>= start end) alist]
|
[(>= start end) (make-alist '())]
|
||||||
[else
|
[else
|
||||||
(match (next-pair str start)
|
(match (next-pair str start)
|
||||||
[#(pair next-start)
|
[#(pair next-start)
|
||||||
(loop next-start end (cons pair alist))]
|
(loop next-start end (lambda (x) (make-alist (cons pair x))))]
|
||||||
[#f alist])])))
|
[#f (make-alist '())])])))
|
||||||
|
|
||||||
))
|
))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user