diff lisp/w3/url-misc.el @ 26:441bb1e64a06 r19-15b96

Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 859a2309aef8
children 8d2a9b52c682
line wrap: on
line diff
--- a/lisp/w3/url-misc.el	Mon Aug 13 08:51:05 2007 +0200
+++ b/lisp/w3/url-misc.el	Mon Aug 13 08:51:32 2007 +0200
@@ -1,7 +1,7 @@
 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
 ;; Author: wmperry
-;; Created: 1997/02/08 05:29:22
-;; Version: 1.10
+;; Created: 1997/02/19 00:52:07
+;; Version: 1.12
 ;; Keywords: comm, data, processes
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -36,7 +36,7 @@
       (kill-buffer url-working-buffer))
   (let* ((data (url-generic-parse-url url))
 	 (fname (url-filename data))
-	 (node (or (url-target data) "Top")))
+	 (node (url-unhex-string (or (url-target data) "Top"))))
     (if (and fname node)
 	(Info-goto-node (concat "(" fname ")" node))
       (error "Malformed url: %s" url))))
@@ -126,84 +126,7 @@
   (let (
 	(urlobj (url-generic-parse-url url))
 	(proxyobj (url-generic-parse-url url-using-proxy)))
-    (url-http url-using-proxy url)
-    (setq url-current-type (url-type urlobj)
-	  url-current-user (url-user urlobj)
-	  url-current-port (or (url-port urlobj)
-			       (cdr-safe (assoc url-current-type
-						url-default-ports)))
-	  url-current-server (url-host urlobj)
-	  url-current-file (url-filename urlobj))))
-
-(defun url-x-exec (url)
-  ;; Handle local execution of scripts.
-  (set-buffer (get-buffer-create url-working-buffer))
-  (erase-buffer)
-  (string-match "x-exec:/+\\([^/]+\\)\\(/.*\\)" url)
-  (let ((process-environment process-environment)
-	(executable (url-match url 1))
-	(path-info (url-match url 2))
-	(query-string nil)
-	(safe-paths url-local-exec-path)
-	(found nil)
-	(y nil)
-	)
-    (setq url-current-server executable
-	  url-current-file path-info)
-    (if (string-match "\\(.*\\)\\?\\(.*\\)" path-info)
-	(setq query-string (url-match path-info 2)
-	      path-info (url-match path-info 1)))
-    (while (and safe-paths (not found))
-      (setq y (expand-file-name executable (car safe-paths))
-	    found (and (file-exists-p y) (file-executable-p y) y)
-	    safe-paths (cdr safe-paths)))
-    (if (not found)
-	(url-retrieve (concat "www://error/nofile/" executable))
-      (setq process-environment
-	    (append
-	     (list
-	      "SERVER_SOFTWARE=x-exec/1.0"
-	      (concat "SERVER_NAME=" (system-name))
-	      "GATEWAY_INTERFACE=CGI/1.1"
-	      "SERVER_PROTOCOL=HTTP/1.0"
-	      "SERVER_PORT="
-	      (concat "REQUEST_METHOD=" url-request-method)
-	      (concat "HTTP_ACCEPT="
-		      (mapconcat
-		       (function
-			(lambda (x)
-			  (cond
-			   ((= x ?\n) (setq y t) "")
-			   ((= x ?:) (setq y nil) ",")
-			   (t (char-to-string x))))) url-mime-accept-string
-		       ""))
-	      (concat "PATH_INFO=" (url-unhex-string path-info))
-	      (concat "PATH_TRANSLATED=" (url-unhex-string path-info))
-	      (concat "SCRIPT_NAME=" executable)
-	      (concat "QUERY_STRING=" (url-unhex-string query-string))
-	      (concat "REMOTE_HOST=" (system-name)))
-	     (if (assoc "content-type" url-request-extra-headers)
-		 (concat "CONTENT_TYPE=" (cdr
-					  (assoc "content-type"
-						 url-request-extra-headers))))
-	     (if url-request-data
-		 (concat "CONTENT_LENGTH=" (length url-request-data)))
-	     process-environment))
-      (and url-request-data (insert url-request-data))
-      (setq y (call-process-region (point-min) (point-max) found t t))
-      (goto-char (point-min))
-      (delete-region (point) (progn (skip-chars-forward " \t\n") (point)))
-      (cond
-       ((url-mime-response-p) nil)	; Its already got an HTTP/1.0 header
-       ((null y)			; Weird exit status, whassup?
-	(insert "HTTP/1.0 404 Not Found\n"
-		"Server: " url-package-name "/x-exec\n"))	
-       ((= 0 y)				; The shell command was successful
-	(insert "HTTP/1.0 200 Document follows\n"
-		"Server: " url-package-name "/x-exec\n"))	
-       (t				; Non-zero exit status is bad bad bad
-	(insert "HTTP/1.0 404 Not Found\n"
-		"Server: " url-package-name "/x-exec\n"))))))
+    (url-http url-using-proxy url)))
 
 ;; ftp://ietf.org/internet-drafts/draft-masinter-url-data-02.txt
 (defun url-data (url)