; The LAML library and programs written by Kurt Normark, Aalborg University, Denmark. ; Copyright (C) 1999 Kurt Normark. ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program; if not, write to the Free Software ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 US ;;;; URLs are encoded in order to avoid special characters causing problems in an Internet adresss. ;;;; This library provides functions to encode and decode parts of an URL. The main functions are ;;;; encode-a-list and string-decode (also known as extract-attributes). ;;;; Encode-a-list takes an association list and encodes it to a string with '=' and '&' representation. ;;;; string-decode (extract-attributes) takes a string, such as produced by encode-a-list, and returns an association list. ;;;; Thus, each of the two functions are inverse version of the other function.<p> ;;;; This library requires the general and the hex library to be loaded. ;;; Encoding stuff. ;; A vector which controls the working of encode-string and encode-a-list (and others). ;; The vector contains 128 entries. Entry n contains the encoding of character n. ;; All % encodings must be strings of lenght exactly 3. ;; Chars outside the range (chars between 128 and 255) are intended always to be encoded.![]()
![]()
(define encode-vector (list->vector '("%00" "%01" "%02" "%03" "%04" "%05" "%06" "%07" "%08" "%09" "%0a" "%0b" "%0c" "%0d" "%0e" "%0f" "%10" "%11" "%12" "%13" "%14" "%15" "%16" "%17" "%18" "%19" "%1a" "%1b" "%1c" "%1d" "%1e" "%1f" "%20" "%21" "%22" "%23" "%24" "%25" "%26" "%27" "%28" "%29" "%2a" "%2b" "%2c" "%2d" "%2e" "%2f" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "%3a" "%3b" "%3c" "%3d" "%3e" "%3f" "%40" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "%5b" "%5c" "%5d" "%5e" "%5f" "%60" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "%7b" "%7c" "%7d" "%7e" "%7f")))![]()
![]()
(define (encode-char char) (let* ((n (char->integer char))) (if (and (>= n 0) (<= n 128)) (vector-ref encode-vector n) (string-append "%" (number-in-base n 16))))) ;; Encode the string str, thus protecting a number of special characters. ;; The encoding is controlled by the list encode-vector.![]()
![]()
(define (encode-string str) (encode-string-help str 0 "") )![]()
![]()
(define (encode-string-help str i res) (if (= i (string-length str)) res (encode-string-help str (+ i 1) (string-append res (encode-char (string-ref str i)))))) ;; Encode an a-list (both keys and values). Return a string in whichs the encoded keys and values are puted together as: ;;![]()
![]()
(define (encode-a-list a-list) (let ((res (encode-a-list-1 a-list))) (if (not (null? a-list)) ; remove traling & (substring res 0 (- (string-length res) 1)) res))) ; helping operation to encode-a-list, doing the real work![]()
![]()
(define (encode-a-list-1 a-list) (if (null? a-list) "" (let ((key (car (car a-list))) (val (cdr (car a-list)))) (string-append (encode-string (as-string key)) "=" (encode-string (as-string val)) "&" (encode-a-list-1 (cdr a-list)))))) ; ================================================================================================================ ;;; Decoding stuff. ;;; Because spaces and certain special characters may not appear in URLs, an ;;; encoding scheme is used when it is necessary to generate a URL that ;;; includes them: Each space is converted to a plus sign, and each special ;;; character is replaced by a triplet of characters consisting of a percent ;;; sign and two hexadecimal digits, which together identify the ASCII code ;;; for the character. ; An internal string in which the individual strings of the alist are represented.![]()
![]()
(define decode-out-string "") ;; Decodes and extract the attributes from str and return an association list. ;; In CGI programming, a query string consists of a sequence of ;; equations separated by ampersands, with the name of some attribute on ;; the left-hand side of each equation and the value of that attribute on ;; the right-hand side. ;; This function returns an association list from the string str-a-list, which represents ;; an association list. In the string, the character '=' separates keys and values. ;; Similarly, the character '&' separate key-value pairs. In addition, the '+' ;; character represents a blank space.![]()
![]()
(define (string-decode str-a-list) (set! decode-out-string (make-string (string-length str-a-list) #\space)) (let ((res (decode-string-alist-1 str-a-list 0 (string-length str-a-list) decode-out-string 0 '() "" 'in-key-or-value))) (cond ((and (= 1 (length res)) (empty-string? (car res))) '()) (else (propertylist-to-alist (reverse res)))) )) ;; Decodes and extract the attributes from str and return an association list. ;; Just and alias of string-decode.![]()
![]()
(define extract-attributes string-decode) ; The helping function of decode-string-alist, which drives the underlying state machine![]()
![]()
(define (decode-string-alist-1 instr inptr inlength outstr outptr prop-list collected current-state) (if (= inptr inlength) (cond ((eq? current-state 'in-key-or-value) (cons (substring outstr 0 outptr) prop-list)) ; include the last string ((eq? current-state 'hex3) (cons (substring outstr 0 outptr) prop-list)) ; also here ((eq? current-state 'equal-accepted) (cons "" prop-list)) ; include a trailing empty string ((eq? current-state 'ampersand-accepted) prop-list) ; just return prop-list (else (error "decode-string-a-list-1: Strange end of string input"))) (let* ((inch (string-ref instr inptr)) (trans-res (decode-string-transition current-state inch collected)) (next-state (car trans-res)) (next-collected (cdr trans-res)) ) (cond ((and (eq? next-state 'in-key-or-value) (eq? inch #\+)) (string-set! outstr outptr #\space)) ; handle '+' ((eq? next-state 'in-key-or-value) (string-set! outstr outptr inch)) ; normal case ((eq? next-state 'hex3) (string-set! outstr outptr next-collected)) ; insert hex conversion ) (decode-string-alist-1 instr (+ 1 inptr) inlength outstr (cond ((eq? next-state 'equal-accepted) 0) ((eq? next-state 'ampersand-accepted) 0) ((eq? next-state 'hex1) outptr) ((eq? next-state 'hex2) outptr) (else (+ outptr 1))) (if (or (eq? next-state 'equal-accepted) (eq? next-state 'ampersand-accepted)) (cons (substring outstr 0 outptr) prop-list) prop-list) next-collected next-state) ))) ; STATES in underlying state machine ; equal-accepted: Just accepted a = character ; ampersand-accepted: Just accepted a & character ; in-key-or-value: Just accepted a non hex char in a key or value ; hex1, hex2, hex3: Just accepted first, second and third char of a hex decoding![]()
![]()
(define hex1-state (cons 'hex1 ""))![]()
![]()
(define equal-accepted-state (cons 'equal-accepted ""))![]()
![]()
(define ampersand-accepted-state (cons 'ampersand-accepted ""))![]()
![]()
(define in-key-or-value-state (cons 'in-key-or-value "")) ; The state machine transition function. ; The third parameter is only used when reading %xy. We collect the x and y characters in this parameter.![]()
![]()
(define (decode-string-transition in-state ch hex-collect) (let ((char (as-string ch))) (cond ((eq? in-state 'in-key-or-value) (cond ((eq? ch #\%) hex1-state) ((eq? ch #\=) equal-accepted-state) ((eq? ch #\&) ampersand-accepted-state) (else in-key-or-value-state) )) ((eq? in-state 'hex1) (cons 'hex2 (as-string ch))) ((eq? in-state 'hex2) (cons 'hex3 (two-digit-hex-to-char (string-append hex-collect (as-string ch))))) ((eq? in-state 'hex3) (cond ((eq? ch #\&) ampersand-accepted-state) ((eq? ch #\=) equal-accepted-state) ((eq? ch #\%) hex1-state) (else in-key-or-value-state) )) ((eq? in-state 'ampersand-accepted) (cond ((eq? ch #\%) hex1-state) ((eq? ch #\=) equal-accepted-state) ((eq? ch #\&) ampersand-accepted-state) (else in-key-or-value-state) )) ((eq? in-state 'equal-accepted) (cond ((eq? ch #\%) hex1-state) ((eq? ch #\=) equal-accepted-state) ((eq? ch #\&) ampersand-accepted-state) (else in-key-or-value-state) )) (else (error (string-append "decode-string-transition: Unknown state: " (as-string in-state)))) ))) ; A specialized two digit hex to char conversion function.![]()
![]()
(define (two-digit-hex-to-char two-char-string) (if (= 2 (string-length two-char-string)) (let ((c1 (hex-ciffer->decimal-ciffer (string-ref two-char-string 0))) (c2 (hex-ciffer->decimal-ciffer (string-ref two-char-string 1))) ) (integer->char (+ (* c1 16) c2))) (error "two-digit-hex-to-char: First parameter must be a string of length two")))