Changeset 12850 in project


Ignore:
Timestamp:
12/18/08 21:57:58 (11 years ago)
Author:
sjamaan
Message:

Merge uri-generic changes from release 4 into release 3

Location:
release/3/uri-generic/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/uri-generic/trunk

  • release/3/uri-generic/trunk/uri-generic.scm

    r12842 r12850  
    255255                 (list) char-list)))
    256256
    257  
     257;; Inverse operation: 'pct-decode' a sequence of octets.
     258
     259(define (pct-decode char-list #!optional (char-set char-set:unreserved))
     260  (define (octet-decode h1 h2)
     261    (string->number (list->string (list h1 h2)) 16))
     262  (map (lambda (c)
     263        (match c
     264               ((#\% h1 h2) (let ((dc (integer->char (octet-decode h1 h2))))
     265                              (if (char-set-contains? char-set dc) dc c)))
     266               (else c)))
     267       char-list))
     268
     269
    258270;; RFC3986, section 2.2
    259271;;
     
    523535         (else #f)))
    524536
    525 (define (dec-char->num c)
    526   (case c ((#\0) 0) ((#\1) 1) ((#\2) 2) ((#\3) 3) ((#\4) 4) ((#\5) 5)
    527          ((#\6) 6) ((#\7) 7) ((#\8) 8) ((#\9) 9) (else #f)))
    528                  
    529537(define (ipv4-octet? lst)
    530   (let loop ((n (reverse (map dec-char->num lst))) (i 1) (ax 0))
    531     (if (null? n) (and (>= ax 0) (<= ax 255))
    532         (loop (cdr n) (* i 10) (+ ax (* i (car n)))))))
     538  (and (every (lambda (x) (char-set-contains? char-set:digit x)) lst)
     539       (let ((num (string->number (list->string lst))))
     540         (and num (>= num 0) (<= num 255)))))
    533541
    534542(define (dec-octet s)
     
    754762;;  Percent encoding and decoding
    755763
    756 (define (integer->octets i)
    757   (let loop ((i i) (lst (list)))
    758     (if (zero? i) lst
    759         (loop (quotient i 256) (cons (modulo i 256) lst)))))
    760 
    761 (define (pct? c) (char=? c #\%))
    762 
    763764(define (uri-encode-string str)
    764765  (let ((clst (string->list str)))
     
    766767     (pct-encode clst (char-set-union (char-set #\%) char-set:reserved)))))
    767768
    768 
    769 (define (octets->integer lst)
    770   (let loop ((i 0) (m 1) (lst (reverse lst)))
    771     (if (null? lst) i
    772         (loop (+ i (* (car lst) m)) (* m 256) (cdr lst)))))
    773 
    774 (define (pct-decode char-list #!optional (char-set char-set:unreserved))
    775   (map (lambda (c)
    776         (match c
    777                ((#\% h1 h2) (let ((dc (integer->char (octet-decode h1 h2))))
    778                               (if (char-set-contains? char-set dc) dc c)))
    779                (else c)))
    780        char-list))
    781 
    782 (define (octet-decode h1 h2)
    783   (string->number (list->string (list h1 h2)) 16))
    784 
    785769(define (uri-decode-string str)
    786   (let loop ((clst (uri-string->char-list str)) (p (list))  (nlst (list)))
    787     (if (null? clst)
    788         (uri-char-list->string (reverse nlst))
    789         (match (car clst)
    790                ((and c (? char?)) 
    791                 (if (null? p) (loop (cdr clst) p (cons c nlst))
    792                     (let ((pc (integer->char (octets->integer (reverse p)))))
    793                       (loop (cdr clst) (list) (cons* c pc nlst)))))
    794                ((#\% h1 h2) 
    795                 (loop (cdr clst) (cons (octet-decode h1 h2) p) nlst))
    796                (else (error 'uri-decode-string "invalid URI string " str))))))
     770  (uri-char-list->string (pct-decode (uri-string->char-list str) char-set:full)))
    797771   
    798772(define (uri-string->normalized-char-list str)
    799   (let ((clst (uri-string->char-list str)))
    800     (pct-decode clst)))
     773  (pct-decode (uri-string->char-list str)))
    801774
    802775
Note: See TracChangeset for help on using the changeset viewer.