|
14
|
1 ;;; url-wais.el --- WAIS 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
|
|
|
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
34 ;;; WAIS support
|
|
|
35 ;;; ------------
|
|
|
36 ;;; Here are even more gross hacks that I call native WAIS support.
|
|
|
37 ;;; This code requires a working waisq program that is fully
|
|
|
38 ;;; compatible with waisq from think.com
|
|
|
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
40 (defun url-create-wais-source (server port dbase)
|
|
|
41 ;; Create a temporary wais source description file. Returns the
|
|
|
42 ;; file name the description is in.
|
|
|
43 (let ((x (url-generate-unique-filename))
|
|
|
44 (y (get-buffer-create " *waisq-tmp*")))
|
|
|
45 (save-excursion
|
|
|
46 (set-buffer y)
|
|
|
47 (erase-buffer)
|
|
|
48 (insert
|
|
|
49 (format
|
|
|
50 (concat "(:source\n:version 3\n"
|
|
|
51 ":ip-name \"%s\"\n:tcp-port %s\n"
|
|
|
52 ":database-name \"%s\"\n)")
|
|
|
53 server (if (equal port "") "210" port) dbase))
|
|
|
54 (write-region (point-min) (point-max) x nil nil)
|
|
|
55 (kill-buffer y))
|
|
|
56 x))
|
|
|
57
|
|
|
58 (defun url-wais-stringtoany (str)
|
|
|
59 ;; Return a wais subelement that specifies STR in any database
|
|
|
60 (concat "(:any :size " (length str) " :bytes #( "
|
|
|
61 (mapconcat 'identity str " ")
|
|
|
62 " ) )"))
|
|
|
63
|
|
|
64 ;(defun url-retrieve-wais-docid (server port dbase local-id)
|
|
|
65 ; (call-process "waisretrieve" nil url-working-buffer nil
|
|
|
66 ; (format "%s:%s@%s:%s" (url-unhex-string local-id)
|
|
|
67 ; dbase server port)))
|
|
|
68
|
|
|
69 ;(url-retrieve-wais-docid "quake.think.com" "210" "directory-of-servers"
|
|
|
70 ; "0 2608 /proj/wais/wais-sources/vpiej-l.src")
|
|
|
71 (defun url-retrieve-wais-docid (server port dbase local-id)
|
|
|
72 ;; Retrieve a wais document.
|
|
|
73 ;; SERVER is the server the database is on (:ip-name in source description)
|
|
|
74 ;; PORT is the port number to contact (:tcp-port in the source description)
|
|
|
75 ;; DBASE is the database name (:database-name in the source description)
|
|
|
76 ;; LOCAL-ID is the document (:original-local-id in the question description)
|
|
|
77 (let* ((dbf (url-create-wais-source server port dbase))
|
|
|
78 (qstr (format
|
|
|
79 (concat "(:question :version 2\n"
|
|
|
80 " :result-documents\n"
|
|
|
81 " ( (:document-id\n"
|
|
|
82 " :document\n"
|
|
|
83 " (:document\n"
|
|
|
84 " :headline \"\"\n"
|
|
|
85 " :doc-id\n"
|
|
|
86 " (:doc-id :original-database %s\n"
|
|
|
87 " :original-local-id %s )\n"
|
|
|
88 " :number-of-bytes -1\n"
|
|
|
89 " :type \"\"\n"
|
|
|
90 " :source\n"
|
|
|
91 " (:source-id :filename \"%s\") ) ) ) )")
|
|
|
92 (url-wais-stringtoany dbase)
|
|
|
93 (url-wais-stringtoany (url-unhex-string local-id))
|
|
|
94 dbf))
|
|
|
95 (qf (url-generate-unique-filename)))
|
|
|
96 (set-buffer (get-buffer-create url-working-buffer))
|
|
|
97 (insert qstr)
|
|
|
98 (write-region (point-min) (point-max) qf nil nil)
|
|
|
99 (erase-buffer)
|
|
|
100 (call-process url-waisq-prog nil url-working-buffer nil "-f" qf "-v" "1")
|
|
|
101 (save-excursion
|
|
|
102 (set-buffer url-working-buffer)
|
|
|
103 (setq url-current-file (url-unhex-string local-id)))
|
|
|
104 (condition-case ()
|
|
|
105 (delete-file dbf)
|
|
|
106 (error nil))
|
|
|
107 (condition-case ()
|
|
|
108 (delete-file qf)
|
|
|
109 (error nil))))
|
|
|
110
|
|
|
111 ;(url-perform-wais-query "quake.think.com" "210" "directory-of-servers" "SGML")
|
|
|
112 (defun url-perform-wais-query (server port dbase search)
|
|
|
113 ;; Perform a wais query.
|
|
|
114 ;; SERVER is the server the database is on (:ip-name in source description)
|
|
|
115 ;; PORT is the port number to contact (:tcp-port in the source description)
|
|
|
116 ;; DBASE is the database name (:database-name in the source description)
|
|
|
117 ;; SEARCH is the search term (:seed-words in the question description)"
|
|
|
118 (let ((dbfname (url-create-wais-source server port dbase))
|
|
|
119 (qfname (url-generate-unique-filename))
|
|
|
120 (results 'url-none-gotten))
|
|
|
121 (save-excursion
|
|
|
122 (url-clear-tmp-buffer)
|
|
|
123 (insert
|
|
|
124 (format
|
|
|
125 (concat "(:question\n"
|
|
|
126 " :version 2\n"
|
|
|
127 " :seed-words \"%s\"\n"
|
|
|
128 " :sourcepath \"" url-temporary-directory "\"\n"
|
|
|
129 " :sources\n"
|
|
|
130 " ( (:source-id\n"
|
|
|
131 " :filename \"%s\"\n"
|
|
|
132 " )\n"
|
|
|
133 " )\n"
|
|
|
134 " :maximum-results 100)\n")
|
|
|
135 search dbfname))
|
|
|
136 (write-region (point-min) (point-max) qfname nil nil)
|
|
|
137 (erase-buffer)
|
|
|
138 (call-process url-waisq-prog nil url-working-buffer nil "-g" "-f" qfname)
|
|
|
139 (set-buffer url-working-buffer)
|
|
|
140 (erase-buffer)
|
|
|
141 (setq url-current-server server
|
|
|
142 url-current-port port
|
|
|
143 url-current-file dbase)
|
|
|
144 (insert-file-contents-literally qfname)
|
|
|
145 (goto-char (point-min))
|
|
|
146 (if (re-search-forward "(:question" nil t)
|
|
|
147 (delete-region (point-min) (match-beginning 0)))
|
|
|
148 (url-replace-regexp "Process.*finished.*" "")
|
|
|
149 (subst-char-in-region (point-min) (point-max) 35 32)
|
|
|
150 (goto-char (point-min))
|
|
|
151 (message "Done reading info - parsing results...")
|
|
|
152 (if (re-search-forward ":result-documents[^(]+" nil t)
|
|
|
153 (progn
|
|
|
154 (goto-char (match-end 0))
|
|
|
155 (while (eq results 'url-none-gotten)
|
|
|
156 (condition-case ()
|
|
|
157 (setq results (read (current-buffer)))
|
|
|
158 (error (progn
|
|
|
159 (setq results 'url-none-gotten)
|
|
|
160 (goto-char (match-end 0))))))
|
|
|
161 (erase-buffer)
|
|
|
162 (insert "<title>Results of WAIS search</title>\n"
|
|
|
163 "<h1>Searched " dbase " for " search "</h1>\n"
|
|
|
164 "<hr>\n"
|
|
|
165 "Found <b>" (int-to-string (length results))
|
|
|
166 "</b> matches.\n"
|
|
|
167 "<ol>\n<li>"
|
|
|
168 (mapconcat 'url-parse-wais-doc-id results "\n<li>")
|
|
|
169 "\n</ol>\n<hr>\n"))
|
|
|
170 (message "No results"))
|
|
|
171 (setq url-current-mime-type "text/html")
|
|
|
172 (condition-case ()
|
|
|
173 (delete-file qfname)
|
|
|
174 (error nil))
|
|
|
175 (condition-case ()
|
|
|
176 (delete-file dbfname)
|
|
|
177 (error nil)))))
|
|
|
178
|
|
|
179 (defun url-wais-anytostring (x)
|
|
|
180 ;; Convert a (:any ....) wais construct back into a string.
|
|
|
181 (mapconcat 'char-to-string (car (cdr (memq ':bytes x))) ""))
|
|
|
182
|
|
|
183 (defun url-parse-wais-doc-id (x)
|
|
|
184 ;; Return a list item that points at the doc-id specified by X
|
|
|
185 (let* ((document (car (cdr (memq ':document x))))
|
|
|
186 (doc-id (car (cdr (memq ':doc-id document))))
|
|
|
187 (score (car (cdr (memq ':score x))))
|
|
|
188 (title (car (cdr (memq ':headline document))))
|
|
|
189 (type (car (cdr (memq ':type document))))
|
|
|
190 (size (car (cdr (memq ':number-of-bytes document))))
|
|
|
191 (server (car (cdr (memq ':original-server doc-id))))
|
|
|
192 (dbase (car (cdr (memq ':original-database doc-id))))
|
|
|
193 (localid (car (cdr (memq ':original-local-id doc-id))))
|
|
|
194 (dist-server (car (cdr (memq ':distributor-server doc-id))))
|
|
|
195 (dist-dbase (car (cdr (memq ':distributor-database doc-id))))
|
|
|
196 (dist-id (car (cdr (memq ':distributor-local-id doc-id))))
|
|
|
197 (copyright (or (car (cdr (memq ':copyright-disposition doc-id))) 0)))
|
|
|
198 (format "<a href=\"wais://%s:%s/%s/%s/%d/1=%s;2=%s;3=%s;4=%s;5=%s;6=%s;7=%d;\">%s (Score = %s)</a>"
|
|
|
199 url-current-server url-current-port url-current-file
|
|
|
200 type size
|
|
|
201 (url-hexify-string (url-wais-anytostring server))
|
|
|
202 (url-hexify-string (url-wais-anytostring dbase))
|
|
|
203 (url-hexify-string (url-wais-anytostring localid))
|
|
|
204 (url-hexify-string (url-wais-anytostring dist-server))
|
|
|
205 (url-hexify-string (url-wais-anytostring dist-dbase))
|
|
|
206 (url-hexify-string (url-wais-anytostring dist-id))
|
|
|
207 copyright title score)))
|
|
|
208
|
|
|
209 (defun url-grok-wais-href (url)
|
|
|
210 "Return a list of server, port, database, search-term, doc-id"
|
|
|
211 (if (string-match "wais:/+\\([^/:]+\\):*\\([^/]*\\)/+\\(.*\\)" url)
|
|
|
212 (let ((host (url-match url 1))
|
|
|
213 (port (url-match url 2))
|
|
|
214 (data (url-match url 3)))
|
|
|
215 (list host port data))
|
|
|
216 (make-list 3 nil)))
|
|
|
217
|
|
|
218 (defun url-wais (url)
|
|
|
219 ;; Retrieve a document via WAIS
|
|
|
220 (if (and url-wais-gateway-server url-wais-gateway-port)
|
|
|
221 (url-retrieve
|
|
|
222 (format "http://%s:%s/%s"
|
|
|
223 url-wais-gateway-server
|
|
|
224 url-wais-gateway-port
|
|
|
225 (substring url (match-end 0) nil)))
|
|
|
226 (let ((href (url-grok-wais-href url)))
|
|
|
227 (url-clear-tmp-buffer)
|
|
|
228 (setq url-current-type "wais"
|
|
|
229 url-current-server (nth 0 href)
|
|
|
230 url-current-port (nth 1 href)
|
|
|
231 url-current-file (nth 2 href))
|
|
|
232 (cond
|
|
|
233 ((string-match "2=\\(.*\\);3=\\([^ ;]+\\)" (nth 2 href)); full link
|
|
|
234 (url-retrieve-wais-docid (nth 0 href) (nth 1 href)
|
|
|
235 (url-match (nth 2 href) 1)
|
|
|
236 (url-match (nth 2 href) 2)))
|
|
|
237 ((string-match "\\([^\\?]+\\)\\?\\(.*\\)" (nth 2 href)) ; stored query
|
|
|
238 (url-perform-wais-query (nth 0 href) (nth 1 href)
|
|
|
239 (url-match (nth 2 href) 1)
|
|
|
240 (url-match (nth 2 href) 2)))
|
|
|
241 (t
|
|
|
242 (insert "<title>WAIS search</title>\n"
|
|
|
243 "<h1>WAIS search of " (nth 2 href) "</h1>"
|
|
|
244 "<hr>\n"
|
|
|
245 (format "<form action=\"%s\" enctype=\"application/x-w3-wais\">\n" url)
|
|
|
246 "Enter search term: <input name=\"internal-wais\">\n"
|
|
|
247 "</form>\n"
|
|
|
248 "<hr>\n"))))))
|
|
|
249
|
|
|
250 (provide 'url-wais)
|
|
|
251
|
