Mercurial > hg > xemacs-beta

comparison lisp/w3/url-misc.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 441bb1e64a06
children 8d2a9b52c682
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
1 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code 1 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/02/08 05:29:22 3 ;; Created: 1997/02/19 00:52:07
4 ;; Version: 1.10 4 ;; Version: 1.12
5 ;; Keywords: comm, data, processes 5 ;; Keywords: comm, data, processes
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
34 ;; Fetch an info node 34 ;; Fetch an info node
35 (if (get-buffer url-working-buffer) 35 (if (get-buffer url-working-buffer)
36 (kill-buffer url-working-buffer)) 36 (kill-buffer url-working-buffer))
37 (let* ((data (url-generic-parse-url url)) 37 (let* ((data (url-generic-parse-url url))
38 (fname (url-filename data)) 38 (fname (url-filename data))
39 (node (or (url-target data) "Top"))) 39 (node (url-unhex-string (or (url-target data) "Top"))))
40 (if (and fname node) 40 (if (and fname node)
41 (Info-goto-node (concat "(" fname ")" node)) 41 (Info-goto-node (concat "(" fname ")" node))
42 (error "Malformed url: %s" url)))) 42 (error "Malformed url: %s" url))))
43 43
44 (defun url-finger (url) 44 (defun url-finger (url)
124 ;; Retrieve URL from a proxy. 124 ;; Retrieve URL from a proxy.
125 ;; Expects `url-using-proxy' to be bound to the specific proxy to use." 125 ;; Expects `url-using-proxy' to be bound to the specific proxy to use."
126 (let ( 126 (let (
127 (urlobj (url-generic-parse-url url)) 127 (urlobj (url-generic-parse-url url))
128 (proxyobj (url-generic-parse-url url-using-proxy))) 128 (proxyobj (url-generic-parse-url url-using-proxy)))
129 (url-http url-using-proxy url) 129 (url-http url-using-proxy url)))
130 (setq url-current-type (url-type urlobj)
131 url-current-user (url-user urlobj)
132 url-current-port (or (url-port urlobj)
133 (cdr-safe (assoc url-current-type
134 url-default-ports)))
135 url-current-server (url-host urlobj)
136 url-current-file (url-filename urlobj))))
137
138 (defun url-x-exec (url)
139 ;; Handle local execution of scripts.
140 (set-buffer (get-buffer-create url-working-buffer))
141 (erase-buffer)
142 (string-match "x-exec:/+\\([^/]+\\)\\(/.*\\)" url)
143 (let ((process-environment process-environment)
144 (executable (url-match url 1))
145 (path-info (url-match url 2))
146 (query-string nil)
147 (safe-paths url-local-exec-path)
148 (found nil)
149 (y nil)
150 )
151 (setq url-current-server executable
152 url-current-file path-info)
153 (if (string-match "\\(.*\\)\\?\\(.*\\)" path-info)
154 (setq query-string (url-match path-info 2)
155 path-info (url-match path-info 1)))
156 (while (and safe-paths (not found))
157 (setq y (expand-file-name executable (car safe-paths))
158 found (and (file-exists-p y) (file-executable-p y) y)
159 safe-paths (cdr safe-paths)))
160 (if (not found)
161 (url-retrieve (concat "www://error/nofile/" executable))
162 (setq process-environment
163 (append
164 (list
165 "SERVER_SOFTWARE=x-exec/1.0"
166 (concat "SERVER_NAME=" (system-name))
167 "GATEWAY_INTERFACE=CGI/1.1"
168 "SERVER_PROTOCOL=HTTP/1.0"
169 "SERVER_PORT="
170 (concat "REQUEST_METHOD=" url-request-method)
171 (concat "HTTP_ACCEPT="
172 (mapconcat
173 (function
174 (lambda (x)
175 (cond
176 ((= x ?\n) (setq y t) "")
177 ((= x ?:) (setq y nil) ",")
178 (t (char-to-string x))))) url-mime-accept-string
179 ""))
180 (concat "PATH_INFO=" (url-unhex-string path-info))
181 (concat "PATH_TRANSLATED=" (url-unhex-string path-info))
182 (concat "SCRIPT_NAME=" executable)
183 (concat "QUERY_STRING=" (url-unhex-string query-string))
184 (concat "REMOTE_HOST=" (system-name)))
185 (if (assoc "content-type" url-request-extra-headers)
186 (concat "CONTENT_TYPE=" (cdr
187 (assoc "content-type"
188 url-request-extra-headers))))
189 (if url-request-data
190 (concat "CONTENT_LENGTH=" (length url-request-data)))
191 process-environment))
192 (and url-request-data (insert url-request-data))
193 (setq y (call-process-region (point-min) (point-max) found t t))
194 (goto-char (point-min))
195 (delete-region (point) (progn (skip-chars-forward " \t\n") (point)))
196 (cond
197 ((url-mime-response-p) nil) ; Its already got an HTTP/1.0 header
198 ((null y) ; Weird exit status, whassup?
199 (insert "HTTP/1.0 404 Not Found\n"
200 "Server: " url-package-name "/x-exec\n"))
201 ((= 0 y) ; The shell command was successful
202 (insert "HTTP/1.0 200 Document follows\n"
203 "Server: " url-package-name "/x-exec\n"))
204 (t ; Non-zero exit status is bad bad bad
205 (insert "HTTP/1.0 404 Not Found\n"
206 "Server: " url-package-name "/x-exec\n"))))))
207 130
208 ;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt 131 ;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt
209 (defun url-data (url) 132 (defun url-data (url)
210 (set-buffer (get-buffer-create url-working-buffer)) 133 (set-buffer (get-buffer-create url-working-buffer))
211 (let ((content-type nil) 134 (let ((content-type nil)