home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / url-gopher.el.z / url-gopher.el
Encoding:
Text File  |  1998-05-21  |  16.1 KB  |  470 lines
  1. ;;; url-gopher.el --- Gopher Uniform Resource Locator retrieval code
  2. ;; Author: wmperry
  3. ;; Created: 1997/10/17 14:08:01
  4. ;; Version: 1.9
  5. ;; Keywords: comm, data, processes
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993-1996 by William M. Perry <wmperry@cs.indiana.edu>
  9. ;;; Copyright (c) 1996, 1997 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 ?&) "&")
  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-filename url-current-object))
  248.             (string= "1/" (url-filename url-current-object))
  249.             (string= "1" (url-filename url-current-object)))
  250.         (concat "Gopher root at " (url-host url-current-object)))
  251.            ((string-match (format "^[%s]+/" url-gopher-types)
  252.                   (url-filename url-current-object))
  253.         (substring (url-filename url-current-object) 2 nil))
  254.            (t (url-filename url-current-object)))
  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.     (if (> (length selector) 0)
  268.     (setq selector (substring selector 1 nil)))
  269.     (if (not (processp proc))
  270.     nil
  271.       (save-excursion
  272.     (set-process-sentinel proc 'ignore)
  273.     (process-send-string proc (concat selector "\r\n"))
  274.     (while (and (or (not wait-for)
  275.             (progn
  276.               (goto-char (point-min))
  277.               (not (re-search-forward wait-for nil t))))
  278.             (memq (url-process-status proc) '(run open)))
  279.       (if (not parsed)
  280.           (cond
  281.            ((and (eq ?+ (char-after 1))
  282.              (memq (char-after 2)
  283.                (list ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
  284.         (setq parsed (copy-marker 2)
  285.               len (read parsed))
  286.         (delete-region (point-min) parsed))
  287.            ((and (eq ?+ (char-after 1))
  288.              (eq ?- (char-after 2)))
  289.         (setq len nil
  290.               parsed t)
  291.         (goto-char (point-min))
  292.         (delete-region (point-min) (progn
  293.                          (end-of-line)
  294.                          (point))))
  295.            ((and (eq ?- (char-after 1))
  296.              (eq ?- (char-after 2)))
  297.         (setq parsed t
  298.               len nil)
  299.         (goto-char (point-min))
  300.         (delete-region (point-min) (progn
  301.                          (end-of-line)
  302.                          (point))))))
  303.       (if len (url-lazy-message "Reading... %d of %d bytes (%d%%)"
  304.                     (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.     (while (looking-at "\r") (delete-char 1))))))
  313.  
  314. (defun url-do-gopher-cso-search (descr)
  315.   ;; Do a gopher CSO search and return a plaintext document
  316.   (let ((host (nth 0 descr))
  317.     (port (nth 1 descr))
  318.     (file (nth 2 descr))
  319.     search-type search-term)
  320.     (string-match "search-by=\\([^&]+\\)" file)
  321.     (setq search-type (url-match file 1))
  322.     (string-match "search-term=\\([^&]+\\)" file)
  323.     (setq search-term (url-match file 1))
  324.     (url-gopher-retrieve host port (format "2query %s=%s"
  325.                       search-type search-term) "^[2-9]")
  326.     (goto-char (point-min))
  327.     (url-replace-regexp "^-[0-9][0-9][0-9]:[0-9]*:" "")
  328.     (url-replace-regexp "^[^15][0-9][0-9]:.*" "")
  329.     (url-replace-regexp "^[15][0-9][0-9]:\\(.*\\)" "<H1>\\1</H1> <PRE>")
  330.     (goto-char (point-min))
  331.     (insert "<title>Results of CSO search</title>\n"
  332.         "<h1>" search-type " = " search-term "</h1>\n")
  333.     (goto-char (point-max))
  334.     (insert "</pre>")))
  335.  
  336. (defun url-do-gopher (descr)
  337.   ;; Fetch a gopher object
  338.   (let ((host (nth 0 descr))
  339.     (port (nth 1 descr))
  340.     (file (nth 2 descr))
  341.     (type (nth 3 descr))
  342.     (extr (nth 4 descr))
  343.     parse-gopher)
  344.     (cond
  345.      ((and                ; Gopher CSO search
  346.        (equal type "www/gopher-cso-search")
  347.        (string-match "search-by=" file)) ; With a search term in it
  348.       (url-do-gopher-cso-search descr)
  349.       (setq type "text/html"))
  350.      ((equal type "www/gopher-cso-search") ; Blank CSO search
  351.       (url-clear-tmp-buffer)
  352.       (insert "<html>\n"
  353.           " <head>\n"
  354.           "  <title>CSO Search</title>\n"
  355.           " </head>\n"
  356.           " <body>\n"
  357.           "  <div>\n"
  358.           "   <h1>This is a CSO search</h1>\n"
  359.           "   <hr>\n"
  360.           "   <form>\n"
  361.           "    <ul>\n"
  362.           "     <li> Search by: <select name=\"search-by\">\n"
  363.           "                      <option>Name\n"
  364.           "                      <option>Phone\n"
  365.           "                      <option>Email\n"
  366.           "                      <option>Address\n"
  367.           "                     </select>\n"
  368.           "     <li> Search for: <input name=\"search-term\">\n"
  369.           "     <li> <input type=\"submit\" value=\"Submit query\">\n"
  370.           "    </ul>\n"
  371.           "   </form>\n"
  372.           "  </div>\n"
  373.           " </body>\n"
  374.           "</html>\n"
  375.           "<!-- Automatically generated by URL v" url-version " -->\n")
  376.       (setq type "text/html"
  377.         parse-gopher t))
  378.      ((and
  379.        (equal type "www/gopher-search")    ; Ack!  Mosaic-style search href
  380.        (string-match "\t" file))    ; and its got a search term in it!
  381.       (url-gopher-retrieve host port file)
  382.       (setq type "www/gopher"
  383.         parse-gopher t))
  384.      ((and
  385.        (equal type "www/gopher-search")    ; Ack!  Mosaic-style search href
  386.        (string-match "\\?" file))    ; and its got a search term in it!
  387.       (setq file (concat (substring file 0 (match-beginning 0)) "\t"
  388.              (substring file (match-end 0) nil)))
  389.       (url-gopher-retrieve host port file)
  390.       (setq type "www/gopher"
  391.         parse-gopher t))
  392.      ((equal type "www/gopher-search")    ; Ack!  Mosaic-style search href
  393.       (setq type "text/html"
  394.         parse-gopher t)
  395.       (url-clear-tmp-buffer)
  396.       (insert "<html>\n"
  397.           " <head>\n"
  398.           "  <title>Gopher Server</title>\n"
  399.           " </head>\n"
  400.           " <body>\n"
  401.           "  <div>\n"
  402.           "   <h1>Searchable Gopher Index</h1>\n"
  403.           "   <hr>\n"
  404.           "   <p>\n"
  405.           "    Enter the search keywords below\n"
  406.           "   </p>"
  407.           "   <form enctype=\"application/x-gopher-query\">\n"
  408.           "    <input name=\"internal-gopher\">\n"
  409.           "   </form>\n"
  410.           "   <hr>\n"
  411.           "  </div>\n"
  412.           " </body>\n"
  413.           "</html>\n"
  414.           "<!-- Automatically generated by URL v" url-version " -->\n"))
  415.      ((null extr)            ; Normal Gopher link
  416.       (url-gopher-retrieve host port file)
  417.       (setq parse-gopher t))
  418.      ((eq extr 'gopher+)        ; A gopher+ link
  419.       (url-gopher-retrieve host port (concat file "\t+"))
  420.       (setq parse-gopher t))
  421.      ((eq extr 'ask-block)        ; A gopher+ interactive query
  422.       (url-gopher-retrieve host port (concat file "\t!")) ; Fetch the info
  423.       (goto-char (point-min))
  424.       (cond
  425.        ((re-search-forward "^\\+ASK:[ \t\r]*" nil t) ; There is an ASK
  426.     (let ((x (buffer-substring (1+ (point))
  427.                    (or (re-search-forward "^\\+[^:]+:" nil t)
  428.                        (point-max)))))
  429.       (erase-buffer)
  430.       (insert (url-convert-ask-to-form x))
  431.       (setq type "text/html" parse-gopher t)))
  432.        (t (setq parse-gopher t)))))
  433.     (if (or (equal type "www/gopher")
  434.         (equal type "text/plain")
  435.         (equal file "")
  436.         (equal type "text/html"))
  437.     (url-gopher-clean-text))
  438.     (if (and parse-gopher (or (equal type "www/gopher")
  439.                   (equal file "")))
  440.     (progn
  441.       (url-parse-gopher)
  442.       (setq type "text/html"
  443.         url-current-mime-viewer (mm-mime-info type nil 5))))
  444.     (setq url-current-mime-type (or type "text/plain")
  445.       url-current-mime-viewer (mm-mime-info type nil 5))))
  446.  
  447. (defun url-gopher (url)
  448.   ;; Handle gopher URLs
  449.   (let ((descr (url-grok-gopher-href url)))
  450.     (cond
  451.      ((or (not (member (nth 1 descr) url-bad-port-list))
  452.       (funcall
  453.        url-confirmation-func
  454.        (format "Warning!  Trying to connect to port %s - continue? "
  455.            (nth 1 descr))))
  456.       (if url-use-hypertext-gopher
  457.       (url-do-gopher descr)
  458.     (gopher-dispatch-object (vector (if (= 0 (length (nth 2 descr)))
  459.                         ?1
  460.                       (string-to-char (nth 2 descr)))
  461.                     (nth 2 descr) (nth 2 descr)
  462.                     (nth 0 descr)
  463.                     (string-to-int (nth 1 descr)))
  464.                 (current-buffer))))
  465.      (t
  466.       (ding)
  467.       (url-warn 'security "Aborting connection to bad port...")))))
  468.  
  469. (provide 'url-gopher)
  470.