diff options
author | 2011-02-22 22:16:19 +0100 | |
---|---|---|
committer | 2011-02-22 22:19:30 +0100 | |
commit | 1636c96f9ff85de266e96b7724f07a44ec255924 (patch) | |
tree | 52392a7b31661e1e5e23718fc36d4f8c760abc8c /tekuti | |
parent | 800e7d9a05bb33d711ce3c39e83886ec548209c9 (diff) | |
download | tekuti-1636c96f9ff85de266e96b7724f07a44ec255924.tar.gz tekuti-1636c96f9ff85de266e96b7724f07a44ec255924.zip |
remove obsolete (tekuti url)
* tekuti/url.scm: Remove.
* Makefile.am: Remove url.scm
* tekuti/post.scm: Remove reference to (tekuti url).
(parse-post-data): Use uri-encode.
Diffstat (limited to 'tekuti')
-rw-r--r-- | tekuti/post.scm | 6 | ||||
-rw-r--r-- | tekuti/url.scm | 187 |
2 files changed, 3 insertions, 190 deletions
diff --git a/tekuti/post.scm b/tekuti/post.scm index d280ac2..939afe6 100644 --- a/tekuti/post.scm +++ b/tekuti/post.scm @@ -26,9 +26,9 @@ (define-module (tekuti post) #:use-module (srfi srfi-1) + #:use-module (web uri) #:use-module (tekuti match-bind) #:use-module (tekuti util) - #:use-module (tekuti url) #:use-module (tekuti comment) #:use-module (tekuti config) #:use-module (tekuti git) @@ -190,10 +190,10 @@ (comment_status . ,(if comments-open? "open" "closed")) (timestamp . ,timestamp) (name . ,name) - (key . ,(url:encode + (key . ,(uri-encode (string-append (date->string (timestamp->date timestamp) "~Y/~m/~d/") - (url:encode name)))))))) + (uri-encode name)))))))) (define (make-new-post post-data) (munge-post #f (parse-post-data post-data))) diff --git a/tekuti/url.scm b/tekuti/url.scm deleted file mode 100644 index dc50dea..0000000 --- a/tekuti/url.scm +++ /dev/null @@ -1,187 +0,0 @@ -;;; www/url.scm --- URL manipulation tools - -;; Copyright (C) 1997,2001,2002 Free Software Foundation, Inc. -;; -;; 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, 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 software; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;; Boston, MA 02111-1307 USA -;; - -;;; Commentary: - -;; This module exports the following procedures: -;; (url:scheme url) -;; (url:address url) -;; (url:unknown url) -;; (url:user url) -;; (url:host url) -;; (url:port url) -;; (url:path url) -;; (url:make scheme . args) -;; (url:make-http host port path) -;; (url:make-ftp user host port path) -;; (url:make-mailto address) -;; (url:parse url) -;; (url:unparse url) -;; (url:decode str) -;; (url:encode str reserved-chars) - -;;; Code: - - -;; TODO: -;; * support `user:password@' strings where appropriate in URLs. -;; * make URL parsing smarter. This is good for most TCP/IP-based -;; URL schemes, but parsing is actually specific to each URL scheme. -;; * fill out url:encode, include facilities for URL-scheme-specific -;; encoding methods (e.g. a url-scheme-reserved-char-alist) - -(define-module (tekuti url) - #:use-module ((srfi srfi-1) #:select (filter)) - #:use-module (ice-9 regex)) - -;; `url:scheme' is an unfortunate term, but it is the technical -;; name for that portion of the URL according to RFC 1738. Sigh. - -(define-public (url:scheme url) (vector-ref url 0)) -(define-public (url:address url) (vector-ref url 1)) -(define-public (url:unknown url) (vector-ref url 1)) -(define-public (url:user url) (vector-ref url 1)) -(define-public (url:host url) (vector-ref url 2)) -(define-public (url:port url) (vector-ref url 3)) -(define-public (url:path url) (vector-ref url 4)) - -(define-public (url:make scheme . args) - (apply vector scheme args)) -(define-public (url:make-http host port path) - (vector 'http #f host port path)) -(define-public (url:make-ftp user host port path) - (vector 'ftp user host port path)) -(define-public (url:make-mailto address) - (vector 'mailto address)) - -(define http-regexp (make-regexp "^http://([^:/]+)(:([0-9]+))?(/(.*))?$")) -(define ftp-regexp - (make-regexp "^ftp://(([^@:/]+)@)?([^:/]+)(:([0-9]+))?(/(.*))?$")) -(define mailto-regexp (make-regexp "^mailto:(.*)$")) - -(define-public (url:parse url) - (cond - ((regexp-exec http-regexp url) - => (lambda (m) - (url:make-http (match:substring m 1) - (cond ((match:substring m 3) => string->number) - (else #f)) - (match:substring m 5)))) - - ((regexp-exec ftp-regexp url) - => (lambda (m) - (url:make-ftp (match:substring m 2) - (match:substring m 3) - (cond ((match:substring m 5) => string->number) - (else #f)) - (match:substring m 7)))) - - ((regexp-exec mailto-regexp url) - => (lambda (m) - (url:make-mailto (match:substring m 1)))) - - (else - (url:make 'unknown url)))) - - -(define-public (url:unparse url) - (define (pathy scheme username url) ; username not used! - (format #f "~A://~A~A~A" - scheme - (url:host url) - (cond ((url:port url) => (lambda (port) (format #f ":~A" port))) - (else "")) - (cond ((url:path url) => (lambda (path) (format #f "/~A" path))) - (else "")))) - (case (url:scheme url) - ((http) (pathy 'http #f url)) - ((ftp) (pathy 'ftp (url:user url) url)) - ((mailto) (format #f "mailto:~A" (url:address url))) - ((unknown) (url:unknown url)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (url-decode STR) -;; Turn + into space, and hex-encoded %XX strings into their -;; eight-bit characters. Is a regexp faster than character -;; scanning? Does it incur more overhead (which may be more -;; important for code that frequently gets restarted)? - -(define-public (url:decode str) - (regexp-substitute/global - #f "\\+|%([0-9A-Fa-f][0-9A-Fa-f])" str - 'pre - (lambda (m) - (cond ((string=? "+" (match:substring m 0)) " ") - (else (integer->char - (string->number - (match:substring m 1) - 16))))) - 'post)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; (url-encode STR) -;; The inverse of url-decode. Can't be done easily with -;; a regexp: we would have to construct a regular expression -;; like "[\277-\377]", for example, and Guile strings don't -;; let you interpolate character literals. Pity. -;; URL-encode any characters in STR that are not safe: these -;; include any character not in the SAFE-CHARS list and any -;; character that *is* in the RESERVED-CHARS list argument. - -(define-public (url:encode str) - (with-output-to-string - (lambda () - (for-each (lambda (ch) - (if (safe-char? ch) - (display ch) - (begin - (display #\%) - (display (number->string (char->integer ch) 16))))) - (string->list str))))) - -(define special-chars - (string->list "$-_.+!*'()")) -(define reserved-chars - (string->list ";/?:@&=")) - -(define (safe-char? ch) - ;; ``Thus, only alphanumerics, the special characters "$-_.+!*'(),", and - ;; reserved characters used for their reserved purposes may be used - ;; unencoded within a URL.'' RFC 1738, #2.2. - (or (char-alphabetic? ch) - (char-numeric? ch) - (memv ch special-chars))) - -(define-public (url:path-part path) - (substring path 0 (or (string-index path #\?) (string-length path)))) - -(define-public (url:query-part path) - (let ((q (string-index path #\?))) - (if q (substring path (1+ q)) #f))) - -(define-public (url:path-split path) - (filter (lambda (x) (not (string-null? x))) - (map url:decode (string-split (url:path-part path) #\/)))) - -(define-public (url:path-join path) - (string-join (map url:encode path) "/")) - -;;; www/url.scm ends here |