Mercurial > hg > xemacs-beta

comparison lisp/url/url-gopher.el @ 0:376386a54a3c r19-14

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