Mercurial > hg > xemacs-beta

comparison lisp/w3/url-gopher.el @ 14:9ee227acff29 r19-15b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
13:13c6d0aaafe5 14:9ee227acff29
1 ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code
2 ;; Author: wmperry
3 ;; Created: 1996/10/09 19:00:59
4 ;; Version: 1.3
5 ;; Keywords: comm, data, processes
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
10 ;;;
11 ;;; This file is not part of GNU Emacs, but the same permissions apply.
12 ;;;
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;;; it under the terms of the GNU General Public License as published by
15 ;;; the Free Software Foundation; either version 2, or (at your option)
16 ;;; any later version.
17 ;;;
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details.
22 ;;;
23 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28
29 (require 'url-vars)
30 (require 'url-parse)
31
32 (defun url-grok-gopher-href (url)
33 "Return a list of attributes from a gopher url. List is of the
34 type: host port selector-string MIME-type extra-info"
35 (let (host ; host name
36 port ; Port #
37 selector ; String to send to gopher host
38 type ; MIME type
39 extra ; Extra information
40 x ; Temporary storage for host/port
41 y ; Temporary storage for selector
42 ylen
43 )
44 (or (string-match "gopher:/*\\([^/]+\\)\\(/*\\)" url)
45 (error "Can't understand url %s" url))
46 (setq x (url-match url 1) ; The host (and possible port #)
47 ylen (- (length url) (match-end 2))
48 y (if (= ylen 0) ; The selector (and possible type)
49 ""
50 (url-unhex-string (substring url (- ylen)))))
51
52 ;First take care of the host/port/gopher+ information from the url
53 ;A + after the port # (host:70+) specifies a gopher+ link
54 ;A ? after the port # (host:70?) specifies a gopher+ ask block
55 (if (string-match "^\\([^:]+\\):\\([0-9]+\\)\\([?+]*\\)" x)
56 (setq host (url-match x 1)
57 port (url-match x 2)
58 extra (url-match x 3))
59 (setq host x
60 port "70"
61 extra nil))
62 (cond
63 ((equal extra "") (setq extra nil))
64 ((equal extra "?") (setq extra 'ask-block))
65 ((equal extra "+") (setq extra 'gopher+)))
66
67 ; Next, get the type/get rid of the Mosaic double-typing. Argh.
68 (setq x (string-to-char y) ; Get gopher type
69 selector (if (or url-use-hypertext-gopher
70 (< 3 (length y)))
71 y ; Get the selector string
72 (substring y 1 nil))
73 type (cdr (assoc x url-gopher-to-mime)))
74 (list host port (or selector "") type extra)))
75
76
77 (defun url-convert-ask-to-form (ask)
78 ;; Convert a Gopher+ ASK block into a form. Returns a string to be
79 ;; inserted into a buffer to create the form."
80 (let ((form (concat "<form enctype=application/gopher-ask-block\n"
81 " method=\"GOPHER-ASK\">\n"
82 " <ul plain>\n"))
83 (type "")
84 (x 0)
85 (parms ""))
86 (while (string-match "^\\([^:]+\\): +\\(.*\\)" ask)
87 (setq parms (url-match ask 2)
88 type (url-strip-leading-spaces (downcase (url-match ask 1)))
89 x (1+ x)
90 ask (substring ask (if (= (length ask) (match-end 0))
91 (match-end 0) (1+ (match-end 0))) nil))
92 (cond
93 ((string= "note" type) (setq form (concat form parms)))
94 ((or (string= "ask" type)
95 (string= "askf" type)
96 (string= "choosef" type))
97 (setq parms (url-string-to-tokens parms ?\t)
98 form (format "%s\n<li>%s<input name=\"%d\" value=\"%s\">"
99 form (or (nth 0 parms) "Text:")
100 x (or (nth 1 parms) ""))))
101 ((string= "askp" type)
102 (setq parms (mapcar 'car (nreverse (url-split parms "\t")))
103 form (format
104 "%s\n<li>%s<input name=\"%d\" type=\"password\" value=\"%s\">"
105 form ; Earlier string
106 (or (nth 0 parms) "Password:") ; Prompt
107 x ; Name
108 (or (nth 1 parms) "") ; Default value
109 )))
110 ((string= "askl" type)
111 (setq parms (url-string-to-tokens parms ?\t)
112 form (format "%s\n<li>%s<textarea name=\"%d\">%s</textarea>"
113 form ; Earlier string
114 (or (nth 0 parms) "") ; Prompt string
115 x ; Name
116 (or (nth 1 parms) "") ; Default value
117 )))
118 ((or (string= "select" type)
119 (string= "choose" type))
120 (setq parms (url-string-to-tokens parms ?\t)
121 form (format "%s\n<li>%s<select name=\"%d\">" form (car parms) x)
122 parms (cdr parms))
123 (if (null parms) (setq parms (list "Yes" "No")))
124 (while parms
125 (setq form (concat form "<option>" (car parms) "\n")
126 parms (cdr parms)))
127 (setq form (concat form "</select>")))))
128 (concat form "\n<li><input type=\"SUBMIT\""
129 " value=\"Submit Gopher+ Ask Block\"></ul></form>")))
130
131 (defun url-grok-gopher-line ()
132 "Return a list of link attributes from a gopher string. Order is:
133 title, type, selector string, server, port, gopher-plus?"
134 (let (type selector server port gopher+ st nd)
135 (beginning-of-line)
136 (setq st (point))
137 (end-of-line)
138 (setq nd (point))
139 (save-excursion
140 (mapcar (function
141 (lambda (var)
142 (goto-char st)
143 (skip-chars-forward "^\t\n" nd)
144 (set-variable var (buffer-substring st (point)))
145 (setq st (min (point-max) (1+ (point))))))
146 '(type selector server port))
147 (setq gopher+ (and (/= (1- st) nd) (buffer-substring st nd)))
148 (list type (concat (substring type 0 1) selector) server port gopher+))))
149
150 (defun url-format-gopher-link (gophobj)
151 ;; Insert a gopher link as an <A> tag
152 (let ((title (nth 0 gophobj))
153 (ref (nth 1 gophobj))
154 (type (if (> (length (nth 0 gophobj)) 0)
155 (substring (nth 0 gophobj) 0 1) ""))
156 (serv (nth 2 gophobj))
157 (port (nth 3 gophobj))
158 (plus (nth 4 gophobj))
159 (desc nil))
160 (if (and (equal type "")
161 (> (length title) 0))
162 (setq type (substring title 0 1)))
163 (setq title (and title (substring title 1 nil))
164 title (mapconcat
165 (function
166 (lambda (x)
167 (cond
168 ((= x ?&) "&amp;")
169 ((= x ?<) "&lt;");
170 ((= x ?>) "&gt;");
171 (t (char-to-string x))))) title "")
172 desc (or (cdr (assoc type url-gopher-labels)) "(UNK)"))
173 (cond
174 ((null ref) "")
175 ((equal type "8")
176 (format "<LI> %s <A HREF=\"telnet://%s:%s/\">%s</A>\n"
177 desc serv port title))
178 ((equal type "T")
179 (format "<LI> %s <A HREF=\"tn3270://%s:%s/\">%s</A>\n"
180 desc serv port title))
181 (t (format "<LI> %s <A METHODS=%s HREF=\"gopher://%s:%s/%s\">%s</A>\n"
182 desc type serv (concat port plus)
183 (url-hexify-string ref) title)))))
184
185 (defun url-gopher-clean-text (&optional buffer)
186 "Decode text transmitted by gopher.
187 0. Delete status line.
188 1. Delete `^M' at end of line.
189 2. Delete `.' at end of buffer (end of text mark).
190 3. Delete `.' at beginning of line. (does gopher want this?)"
191 (set-buffer (or buffer url-working-buffer))
192 ;; Insert newline at end of buffer.
193 (goto-char (point-max))
194 (if (not (bolp))
195 (insert "\n"))
196 ;; Delete `^M' at end of line.
197 (goto-char (point-min))
198 (while (re-search-forward "\r[^\n]*$" nil t)
199 (replace-match ""))
200 ; (goto-char (point-min))
201 ; (while (not (eobp))
202 ; (end-of-line)
203 ; (if (= (preceding-char) ?\r)
204 ; (delete-char -1))
205 ; (forward-line 1)
206 ; )
207 ;; Delete `.' at end of buffer (end of text mark).
208 (goto-char (point-max))
209 (forward-line -1) ;(beginning-of-line)
210 (while (looking-at "^\\.$")
211 (delete-region (point) (progn (forward-line 1) (point)))
212 (forward-line -1))
213 ;; Replace `..' at beginning of line with `.'.
214 (goto-char (point-min))
215 ;; (replace-regexp "^\\.\\." ".")
216 (while (search-forward "\n.." nil t)
217 (delete-char -1))
218 )
219
220 (defun url-parse-gopher (&optional buffer)
221 (save-excursion
222 (set-buffer (or buffer url-working-buffer))
223 (url-replace-regexp "^\r*$\n" "")
224 (url-replace-regexp "^\\.\r*$\n" "")
225 (url-gopher-clean-text (current-buffer))
226 (goto-char (point-max))
227 (skip-chars-backward "\n\r\t ")
228 (delete-region (point-max) (point))
229 (insert "\n")
230 (goto-char (point-min))
231 (skip-chars-forward " \t\n")
232 (delete-region (point-min) (point))
233 (let* ((len (count-lines (point-min) (point-max)))
234 (objs nil)
235 (i 0))
236 (while (not (eobp))
237 (setq objs (cons (url-grok-gopher-line) objs)
238 i (1+ i))
239 (url-lazy-message "Converting gopher listing... %d/%d (%d%%)"
240 i len (url-percentage i len))
241
242 (forward-line 1))
243 (setq objs (nreverse objs))
244 (erase-buffer)
245 (insert "<title>"
246 (cond
247 ((or (string= "" url-current-file)
248 (string= "1/" url-current-file)
249 (string= "1" url-current-file))
250 (concat "Gopher root at " url-current-server))
251 ((string-match (format "^[%s]+/" url-gopher-types)
252 url-current-file)
253 (substring url-current-file 2 nil))
254 (t url-current-file))
255 "</title><ol>"
256 (mapconcat 'url-format-gopher-link objs "")
257 "</ol>"))))
258
259 (defun url-gopher-retrieve (host port selector &optional wait-for)
260 ;; Fetch a gopher object and don't mess with it at all
261 (let ((proc (url-open-stream "*gopher*" url-working-buffer
262 host (if (stringp port) (string-to-int port)
263 port)))
264 (len nil)
265 (parsed nil))
266 (url-clear-tmp-buffer)
267 (setq url-current-file selector
268 url-current-port port
269 url-current-server host
270 url-current-type "gopher")
271 (if (> (length selector) 0)
272 (setq selector (substring selector 1 nil)))
273 (if (stringp proc)
274 (message "%s" proc)
275 (save-excursion
276 (process-send-string proc (concat selector "\r\n"))
277 (while (and (or (not wait-for)
278 (progn
279 (goto-char (point-min))
280 (not (re-search-forward wait-for nil t))))
281 (memq (url-process-status proc) '(run open)))
282 (if (not parsed)
283 (cond
284 ((and (eq ?+ (char-after 1))
285 (memq (char-after 2)
286 (list ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
287 (setq parsed (copy-marker 2)
288 len (read parsed))
289 (delete-region (point-min) parsed))
290 ((and (eq ?+ (char-after 1))
291 (eq ?- (char-after 2)))
292 (setq len nil
293 parsed t)
294 (goto-char (point-min))
295 (delete-region (point-min) (progn
296 (end-of-line)
297 (point))))
298 ((and (eq ?- (char-after 1))
299 (eq ?- (char-after 2)))
300 (setq parsed t
301 len nil)
302 (goto-char (point-min))
303 (delete-region (point-min) (progn
304 (end-of-line)
305 (point))))))
306 (if len (url-lazy-message "Reading... %d of %d bytes (%d%%)"
307 (point-max)
308 len
309 (url-percentage (point-max) len))
310 (url-lazy-message "Read... %d bytes." (point-max)))
311 (url-accept-process-output proc))
312 (condition-case ()
313 (url-kill-process proc)
314 (error nil))
315 (url-replace-regexp "\n*Connection closed.*\n*" "")
316 (url-replace-regexp "\n*Process .*gopher.*\n*" "")
317 (while (looking-at "\r") (delete-char 1))))))
318
319 (defun url-do-gopher-cso-search (descr)
320 ;; Do a gopher CSO search and return a plaintext document
321 (let ((host (nth 0 descr))
322 (port (nth 1 descr))
323 (file (nth 2 descr))
324 search-type search-term)
325 (string-match "search-by=\\([^&]+\\)" file)
326 (setq search-type (url-match file 1))
327 (string-match "search-term=\\([^&]+\\)" file)
328 (setq search-term (url-match file 1))
329 (url-gopher-retrieve host port (format "2query %s=%s"
330 search-type search-term) "^[2-9]")
331 (goto-char (point-min))
332 (url-replace-regexp "^-[0-9][0-9][0-9]:[0-9]*:" "")
333 (url-replace-regexp "^[^15][0-9][0-9]:.*" "")
334 (url-replace-regexp "^[15][0-9][0-9]:\\(.*\\)" "<H1>\\1</H1>&ensp;<PRE>")
335 (goto-char (point-min))
336 (insert "<title>Results of CSO search</title>\n"
337 "<h1>" search-type " = " search-term "</h1>\n")
338 (goto-char (point-max))
339 (insert "</pre>")))
340
341 (defun url-do-gopher (descr)
342 ;; Fetch a gopher object
343 (let ((host (nth 0 descr))
344 (port (nth 1 descr))
345 (file (nth 2 descr))
346 (type (nth 3 descr))
347 (extr (nth 4 descr))
348 parse-gopher)
349 (cond
350 ((and ; Gopher CSO search
351 (equal type "www/gopher-cso-search")
352 (string-match "search-by=" file)) ; With a search term in it
353 (url-do-gopher-cso-search descr)
354 (setq type "text/html"))
355 ((equal type "www/gopher-cso-search") ; Blank CSO search
356 (url-clear-tmp-buffer)
357 (insert "<html>\n"
358 " <head>\n"
359 " <title>CSO Search</title>\n"
360 " </head>\n"
361 " <body>\n"
362 " <div>\n"
363 " <h1>This is a CSO search</h1>\n"
364 " <hr>\n"
365 " <form>\n"
366 " <ul>\n"
367 " <li> Search by: <select name=\"search-by\">\n"
368 " <option>Name\n"
369 " <option>Phone\n"
370 " <option>Email\n"
371 " <option>Address\n"
372 " </select>\n"
373 " <li> Search for: <input name=\"search-term\">\n"
374 " <li> <input type=\"submit\" value=\"Submit query\">\n"
375 " </ul>\n"
376 " </form>\n"
377 " </div>\n"
378 " </body>\n"
379 "</html>\n"
380 "<!-- Automatically generated by URL v" url-version " -->\n")
381 (setq type "text/html"
382 parse-gopher t))
383 ((and
384 (equal type "www/gopher-search") ; Ack! Mosaic-style search href
385 (string-match "\t" file)) ; and its got a search term in it!
386 (url-gopher-retrieve host port file)
387 (setq type "www/gopher"
388 parse-gopher t))
389 ((and
390 (equal type "www/gopher-search") ; Ack! Mosaic-style search href
391 (string-match "\\?" file)) ; and its got a search term in it!
392 (setq file (concat (substring file 0 (match-beginning 0)) "\t"
393 (substring file (match-end 0) nil)))
394 (url-gopher-retrieve host port file)
395 (setq type "www/gopher"
396 parse-gopher t))
397 ((equal type "www/gopher-search") ; Ack! Mosaic-style search href
398 (setq type "text/html"
399 parse-gopher t)
400 (url-clear-tmp-buffer)
401 (insert "<html>\n"
402 " <head>\n"
403 " <title>Gopher Server</title>\n"
404 " </head>\n"
405 " <body>\n"
406 " <div>\n"
407 " <h1>Searchable Gopher Index</h1>\n"
408 " <hr>\n"
409 " <p>\n"
410 " Enter the search keywords below\n"
411 " </p>"
412 " <form enctype=\"application/x-gopher-query\">\n"
413 " <input name=\"internal-gopher\">\n"
414 " </form>\n"
415 " <hr>\n"
416 " </div>\n"
417 " </body>\n"
418 "</html>\n"
419 "<!-- Automatically generated by URL v" url-version " -->\n"))
420 ((null extr) ; Normal Gopher link
421 (url-gopher-retrieve host port file)
422 (setq parse-gopher t))
423 ((eq extr 'gopher+) ; A gopher+ link
424 (url-gopher-retrieve host port (concat file "\t+"))
425 (setq parse-gopher t))
426 ((eq extr 'ask-block) ; A gopher+ interactive query
427 (url-gopher-retrieve host port (concat file "\t!")) ; Fetch the info
428 (goto-char (point-min))
429 (cond
430 ((re-search-forward "^\\+ASK:[ \t\r]*" nil t) ; There is an ASK
431 (let ((x (buffer-substring (1+ (point))
432 (or (re-search-forward "^\\+[^:]+:" nil t)
433 (point-max)))))
434 (erase-buffer)
435 (insert (url-convert-ask-to-form x))
436 (setq type "text/html" parse-gopher t)))
437 (t (setq parse-gopher t)))))
438 (if (or (equal type "www/gopher")
439 (equal type "text/plain")
440 (equal file "")
441 (equal type "text/html"))
442 (url-gopher-clean-text))
443 (if (and parse-gopher (or (equal type "www/gopher")
444 (equal file "")))
445 (progn
446 (url-parse-gopher)
447 (setq type "text/html"
448 url-current-mime-viewer (mm-mime-info type nil 5))))
449 (setq url-current-mime-type (or type "text/plain")
450 url-current-mime-viewer (mm-mime-info type nil 5)
451 url-current-file file
452 url-current-port port
453 url-current-server host
454 url-current-type "gopher")))
455
456 (defun url-gopher (url)
457 ;; Handle gopher URLs
458 (let ((descr (url-grok-gopher-href url)))
459 (cond
460 ((or (not (member (nth 1 descr) url-bad-port-list))
461 (funcall
462 url-confirmation-func
463 (format "Warning! Trying to connect to port %s - continue? "
464 (nth 1 descr))))
465 (if url-use-hypertext-gopher
466 (url-do-gopher descr)
467 (gopher-dispatch-object (vector (if (= 0
468 (string-to-char (nth 2 descr)))
469 ?1
470 (string-to-char (nth 2 descr)))
471 (nth 2 descr) (nth 2 descr)
472 (nth 0 descr)
473 (string-to-int (nth 1 descr)))
474 (current-buffer))))
475 (t
476 (ding)
477 (url-warn 'security "Aborting connection to bad port...")))))
478
479 (provide 'url-gopher)