14
|
1 ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code
|
|
2 ;; Author: wmperry
|
20
|
3 ;; Created: 1997/02/08 05:25:58
|
|
4 ;; Version: 1.5
|
14
|
5 ;; Keywords: comm, data, processes
|
|
6
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
8 ;;; Copyright (c) 1993-1996 by William M. Perry (wmperry@cs.indiana.edu)
|
16
|
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
|
14
|
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 ?&) "&")
|
|
169 ((= x ?<) "<");
|
|
170 ((= x ?>) ">");
|
|
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)))
|
20
|
273 (if (not (processp proc))
|
|
274 nil
|
14
|
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> <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)
|