lisp/nnspool.el

   1 ;;; nnspool.el --- spool access using NNTP for GNU Emacs
   2
   3 ;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD.
   4 ;; Copyright (C) 1988, 1989, 1990 Masanobu UMEDA
   5
   6 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   7 ;; Keywords: news
   8
   9 ;; $Header: nnspool.el,v 1.10 90/03/23 13:25:25 umerin Locked $
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY.  No author or distributor
  15 ;; accepts responsibility to anyone for the consequences of using it
  16 ;; or for whether it serves any particular purpose or works at all,
  17 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  18 ;; License for full details.
  19
  20 ;; Everyone is granted permission to copy, modify and redistribute
  21 ;; GNU Emacs, but only under the conditions described in the
  22 ;; GNU Emacs General Public License.   A copy of this license is
  23 ;; supposed to have been given to you along with GNU Emacs so you
  24 ;; can know your rights and responsibilities.  It should be in a
  25 ;; file named COPYING.  Among other things, the copyright notice
  26 ;; and this notice must be preserved on all copies.
  27
  28 ;;; Code:
  29
  30 (require 'nntp)
  31
  32 (defvar nnspool-inews-program news-inews-program
  33   "*Program to post news.")
  34
  35 (defvar nnspool-inews-switches '("-h")
  36   "*Switches for nnspool-request-post to pass to `inews' for posting news.")
  37
  38 (defvar nnspool-spool-directory news-path
  39   "*Local news spool directory.")
  40
  41 (defvar nnspool-active-file "/usr/lib/news/active"
  42   "*Local news active file.")
  43
  44 (defvar nnspool-history-file "/usr/lib/news/history"
  45   "*Local news history file.")
  46
  47 \f
  48
  49 (defconst nnspool-version "NNSPOOL 1.10"
  50   "Version numbers of this version of NNSPOOL.")
  51
  52 (defvar nnspool-current-directory nil
  53   "Current news group directory.")
  54
  55 ;;;
  56 ;;; Replacement of Extended Command for retrieving many headers.
  57 ;;;
  58
  59 (defun nnspool-retrieve-headers (sequence)
  60   "Return list of article headers specified by SEQUENCE of article id.
  61 The format of list is
  62  `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
  63 Reader macros for the vector are defined as `nntp-header-FIELD'.
  64 Writer macros for the vector are defined as `nntp-set-header-FIELD'.
  65 News group must be selected before calling me."
  66   (save-excursion
  67     (set-buffer nntp-server-buffer)
  68     ;;(erase-buffer)
  69     (let ((file nil)
  70           (number (length sequence))
  71           (count 0)
  72           (headers nil)                 ;Result list.
  73           (article 0)
  74           (subject nil)
  75           (message-id nil)
  76           (from nil)
  77           (xref nil)
  78           (lines 0)
  79           (date nil)
  80           (references nil))
  81       (while sequence
  82         ;;(nntp-send-strings-to-server "HEAD" (car sequence))
  83         (setq article (car sequence))
  84         (setq file
  85               (concat nnspool-current-directory (prin1-to-string article)))
  86         (if (and (file-exists-p file)
  87                  (not (file-directory-p file)))
  88             (progn
  89               (erase-buffer)
  90               (insert-file-contents file)
  91               ;; Make message body invisible.
  92               (goto-char (point-min))
  93               (search-forward "\n\n" nil 'move)
  94               (narrow-to-region (point-min) (point))
  95               ;; Fold continuation lines.
  96               (goto-char (point-min))
  97               (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  98                 (replace-match " " t t))
  99               ;; Make it possible to search for `\nFIELD'.
 100               (goto-char (point-min))
 101               (insert "\n")
 102               ;; Extract From:
 103               (goto-char (point-min))
 104               (if (search-forward "\nFrom: " nil t)
 105                   (setq from (buffer-substring
 106                               (point)
 107                               (save-excursion (end-of-line) (point))))
 108                 (setq from "(Unknown User)"))
 109               ;; Extract Subject:
 110               (goto-char (point-min))
 111               (if (search-forward "\nSubject: " nil t)
 112                   (setq subject (buffer-substring
 113                                  (point)
 114                                  (save-excursion (end-of-line) (point))))
 115                 (setq subject "(None)"))
 116               ;; Extract Message-ID:
 117               (goto-char (point-min))
 118               (if (search-forward "\nMessage-ID: " nil t)
 119                   (setq message-id (buffer-substring
 120                                     (point)
 121                                     (save-excursion (end-of-line) (point))))
 122                 (setq message-id nil))
 123               ;; Extract Date:
 124               (goto-char (point-min))
 125               (if (search-forward "\nDate: " nil t)
 126                   (setq date (buffer-substring
 127                               (point)
 128                               (save-excursion (end-of-line) (point))))
 129                 (setq date nil))
 130               ;; Extract Lines:
 131               (goto-char (point-min))
 132               (if (search-forward "\nLines: " nil t)
 133                   (setq lines (string-to-int
 134                                (buffer-substring
 135                                 (point)
 136                                 (save-excursion (end-of-line) (point)))))
 137                 (setq lines 0))
 138               ;; Extract Xref:
 139               (goto-char (point-min))
 140               (if (search-forward "\nXref: " nil t)
 141                   (setq xref (buffer-substring
 142                               (point)
 143                               (save-excursion (end-of-line) (point))))
 144                 (setq xref nil))
 145               ;; Extract References:
 146               (goto-char (point-min))
 147               (if (search-forward "\nReferences: " nil t)
 148                   (setq references (buffer-substring
 149                                     (point)
 150                                     (save-excursion (end-of-line) (point))))
 151                 (setq references nil))
 152               (setq headers
 153                     (cons (vector article subject from
 154                                   xref lines date
 155                                   message-id references) headers))
 156               ))
 157         (setq sequence (cdr sequence))
 158         (setq count (1+ count))
 159         (and (numberp nntp-large-newsgroup)
 160              (> number nntp-large-newsgroup)
 161              (zerop (% count 20))
 162              (message "NNSPOOL: %d%% of headers received."
 163                       (/ (* count 100) number)))
 164         )
 165       (and (numberp nntp-large-newsgroup)
 166            (> number nntp-large-newsgroup)
 167            (message "NNSPOOL: 100%% of headers received."))
 168       (nreverse headers)
 169       )))
 170
 171 \f
 172 ;;;
 173 ;;; Replacement of NNTP Raw Interface.
 174 ;;;
 175
 176 (defun nnspool-open-server (host &optional service)
 177   "Open news server on HOST.
 178 If HOST is nil, use value of environment variable `NNTPSERVER'.
 179 If optional argument SERVICE is non-nil, open by the service name."
 180   (let ((host (or host (getenv "NNTPSERVER")))
 181         (status nil))
 182     (setq nntp-status-message-string "")
 183     (cond ((and (file-directory-p nnspool-spool-directory)
 184                 (file-exists-p nnspool-active-file)
 185                 (string-equal host (system-name)))
 186            (setq status (nnspool-open-server-internal host service)))
 187           ((string-equal host (system-name))
 188            (setq nntp-status-message-string
 189                  (format "%s has no news spool.  Goodbye." host)))
 190           ((null host)
 191            (setq nntp-status-message-string "NNTP server is not specified."))
 192           (t
 193            (setq nntp-status-message-string
 194                  (format "NNSPOOL: cannot talk to %s." host)))
 195           )
 196     status
 197     ))
 198
 199 (defun nnspool-close-server ()
 200   "Close news server."
 201   (nnspool-close-server-internal))
 202
 203 (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server))
 204
 205 (defun nnspool-server-opened ()
 206   "Return server process status, T or NIL.
 207 If the stream is opened, return T, otherwise return NIL."
 208   (and nntp-server-buffer
 209        (get-buffer nntp-server-buffer)))
 210
 211 (defun nnspool-status-message ()
 212   "Return server status response as string."
 213   nntp-status-message-string
 214   )
 215
 216 (defun nnspool-request-article (id)
 217   "Select article by message ID (or number)."
 218   (let ((file (if (stringp id)
 219                   (nnspool-find-article-by-message-id id)
 220                 (concat nnspool-current-directory (prin1-to-string id)))))
 221     (if (and (stringp file)
 222              (file-exists-p file)
 223              (not (file-directory-p file)))
 224         (save-excursion
 225           (nnspool-find-file file)))
 226     ))
 227
 228 (defun nnspool-request-body (id)
 229   "Select article body by message ID (or number)."
 230   (if (nnspool-request-article id)
 231       (save-excursion
 232         (set-buffer nntp-server-buffer)
 233         (goto-char (point-min))
 234         (if (search-forward "\n\n" nil t)
 235             (delete-region (point-min) (point)))
 236         t
 237         )
 238     ))
 239
 240 (defun nnspool-request-head (id)
 241   "Select article head by message ID (or number)."
 242   (if (nnspool-request-article id)
 243       (save-excursion
 244         (set-buffer nntp-server-buffer)
 245         (goto-char (point-min))
 246         (if (search-forward "\n\n" nil t)
 247             (delete-region (1- (point)) (point-max)))
 248         t
 249         )
 250     ))
 251
 252 (defun nnspool-request-stat (id)
 253   "Select article by message ID (or number)."
 254   (error "NNSPOOL: STAT is not implemented."))
 255
 256 (defun nnspool-request-group (group)
 257   "Select news GROUP."
 258   (let ((pathname (nnspool-article-pathname
 259                    (nnspool-replace-chars-in-string group ?. ?/))))
 260     (if (file-directory-p pathname)
 261         (setq nnspool-current-directory pathname))
 262     ))
 263
 264 (defun nnspool-request-list ()
 265   "List valid newsgoups."
 266   (save-excursion
 267     (nnspool-find-file nnspool-active-file)))
 268
 269 (defun nnspool-request-last ()
 270   "Set current article pointer to the previous article in the current news group."
 271   (error "NNSPOOL: LAST is not implemented."))
 272
 273 (defun nnspool-request-next ()
 274   "Advance current article pointer."
 275   (error "NNSPOOL: NEXT is not implemented."))
 276
 277 (defun nnspool-request-post ()
 278   "Post a new news in current buffer."
 279   (save-excursion
 280     ;; We have to work in the server buffer because of NEmacs hack.
 281     (copy-to-buffer nntp-server-buffer (point-min) (point-max))
 282     (set-buffer nntp-server-buffer)
 283     (apply 'call-process-region
 284            (point-min) (point-max)
 285            nnspool-inews-program 'delete t nil nnspool-inews-switches)
 286     (prog1
 287         (or (zerop (buffer-size))
 288             ;; If inews returns strings, it must be error message
 289             ;;  unless SPOOLNEWS is defined.
 290             ;; This condition is very weak, but there is no good rule
 291             ;;  identifying errors when SPOOLNEWS is defined.
 292             ;; Suggested by ohm@kaba.junet.
 293             (string-match "spooled" (buffer-string)))
 294       ;; Make status message by unfolding lines.
 295       (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
 296       (setq nntp-status-message-string (buffer-string))
 297       (erase-buffer))
 298     ))
 299
 300 \f
 301 ;;;
 302 ;;; Replacement of Low-Level Interface to NNTP Server.
 303 ;;;
 304
 305 (defun nnspool-open-server-internal (host &optional service)
 306   "Open connection to news server on HOST by SERVICE (default is nntp)."
 307   (save-excursion
 308     (if (not (string-equal host (system-name)))
 309         (error "NNSPOOL: cannot talk to %s." host))
 310     ;; Initialize communication buffer.
 311     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
 312     (set-buffer nntp-server-buffer)
 313     (buffer-flush-undo (current-buffer))
 314     (erase-buffer)
 315     (kill-all-local-variables)
 316     (setq case-fold-search t)           ;Should ignore case.
 317     (setq nntp-server-process nil)
 318     (setq nntp-server-name host)
 319     ;; It is possible to change kanji-fileio-code in this hook.
 320     (run-hooks 'nntp-server-hook)
 321     t
 322     ))
 323
 324 (defun nnspool-close-server-internal ()
 325   "Close connection to news server."
 326   (if (get-file-buffer nnspool-history-file)
 327       (kill-buffer (get-file-buffer nnspool-history-file)))
 328   (if nntp-server-buffer
 329       (kill-buffer nntp-server-buffer))
 330   (setq nntp-server-buffer nil)
 331   (setq nntp-server-process nil))
 332
 333 (defun nnspool-find-article-by-message-id (id)
 334   "Return full pathname of an article identified by message-ID."
 335   (save-excursion
 336     (let ((buffer (get-file-buffer nnspool-history-file)))
 337       (if buffer
 338           (set-buffer buffer)
 339         ;; Finding history file may take lots of time.
 340         (message "Reading history file...")
 341         (set-buffer (find-file-noselect nnspool-history-file))
 342         (message "Reading history file... done")))
 343     ;; Search from end of the file. I think this is much faster than
 344     ;; do from the beginning of the file.
 345     (goto-char (point-max))
 346     (if (re-search-backward
 347          (concat "^" (regexp-quote id)
 348                  "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
 349         (let ((group (buffer-substring (match-beginning 1) (match-end 1)))
 350               (number (buffer-substring (match-beginning 2) (match-end 2))))
 351           (concat (nnspool-article-pathname
 352                    (nnspool-replace-chars-in-string group ?. ?/))
 353                   number))
 354       )))
 355
 356 (defun nnspool-find-file (file)
 357   "Insert FILE in server buffer safely."
 358   (set-buffer nntp-server-buffer)
 359   (erase-buffer)
 360   (condition-case ()
 361       (progn (insert-file-contents file) t)
 362     (file-error nil)
 363     ))
 364
 365 (defun nnspool-article-pathname (group)
 366   "Make pathname for GROUP."
 367   (concat (file-name-as-directory nnspool-spool-directory) group "/"))
 368
 369 (defun nnspool-replace-chars-in-string (string from to)
 370   "Replace characters in STRING from FROM to TO."
 371   (let ((string (substring string 0))   ;Copy string.
 372         (len (length string))
 373         (idx 0))
 374     ;; Replace all occurence of FROM with TO.
 375     (while (< idx len)
 376       (if (= (aref string idx) from)
 377           (aset string idx to))
 378       (setq idx (1+ idx)))
 379     string
 380     ))
 381
 382 (provide 'nnspool)
 383
 384 ;;; nnspool.el ends here