cgit.sxemacs.org Git - gnus/blob - lisp/nnspool.el

   1 ;;; nnspool.el --- spool access for GNU Emacs
   2
   3 ;; Copyright (C) 1988, 89, 90, 93, 94, 95 Free Software Foundation, Inc.
   4
   5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   6 ;;      Lars Ingebrigtsen <larsi@ifi.uio.no>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; All the Gnus backends have the same interface, and should return
  28 ;; data in a similar format. Below is and overview of what functions
  29 ;; these packages must supply and what result they should return.
  30 ;;
  31 ;; Variables:
  32 ;;
  33 ;; `nntp-server-buffer' - All data should be returned to Gnus in this
  34 ;; buffer.
  35 ;;
  36 ;; Functions for the imaginary backend `choke':
  37 ;;
  38 ;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
  39 ;; Should return all headers for all ARTICLES, or return NOV lines for
  40 ;; the same.
  41 ;;
  42 ;; `choke-request-group GROUP &optional SERVER DISCARD'
  43 ;; Switch to GROUP. If DISCARD is nil, active information on the group
  44 ;; must be returned.
  45 ;;
  46 ;; `choke-request-article ARTICLE &optional GROUP SERVER'
  47 ;; Return ARTICLE, which is either an article number or id.
  48 ;;
  49 ;; `choke-request-list SERVER'
  50 ;; Return a list of all active newsgroups on SERVER.
  51 ;;
  52 ;; `choke-request-list-newsgroups SERVER'
  53 ;; Return a list of descriptions of all newsgroups on SERVER.
  54 ;;
  55 ;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
  56 ;; Should return a buffer that is suitable for "posting". nnspool and
  57 ;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
  58 ;; buffer. This function should fill out the appropriate header
  59 ;; fields.
  60 ;;
  61 ;; `choke-request-post &optional SERVER'
  62 ;; Function that will be called from a buffer to be posted.
  63 ;;
  64 ;; `choke-open-server SERVER &optional ARGUMENT'
  65 ;; Open a connection to SERVER.
  66 ;;
  67 ;; `choke-close-server &optional SERVER'
  68 ;; Close the connection to server.
  69 ;;
  70 ;; `choke-server-opened &optional SERVER'
  71 ;; Whether the server is opened or not.
  72 ;;
  73 ;; `choke-server-status &optional SERVER'
  74 ;; Should return a status string (not in nntp buffer, but as the
  75 ;; result of the function).
  76 ;;
  77 ;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
  78 ;; Should expire (according to some aging scheme) all ARTICLES. Most
  79 ;; backends will not be able to expire articles. Should return a list
  80 ;; of all articles that were not expired.
  81 ;;
  82 ;; All these functions must return nil if they couldn't service the
  83 ;; request. If the optional arguments are not supplied, some "current"
  84 ;; or "default" values should be used. In short, one should emulate an
  85 ;; NNTP server, in a way. All results should be returned in the NNTP
  86 ;; format. (See RFC977).
  87
  88 ;;; Code:
  89
  90 (require 'nnheader)
  91 (require 'nntp)
  92
  93 (defvar nnspool-inews-program news-inews-program
  94   "*Program to post news.")
  95
  96 (defvar nnspool-inews-switches '("-h")
  97   "*Switches for nnspool-request-post to pass to `inews' for posting news.")
  98
  99 (defvar nnspool-spool-directory news-path
 100   "*Local news spool directory.")
 101
 102 (defvar nnspool-active-file "/usr/lib/news/active"
 103   "*Local news active file.")
 104
 105 (defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups"
 106   "*Local news newsgroups file.")
 107
 108 (defvar nnspool-distributions-file "/usr/lib/news/distributions"
 109   "*Local news distributions file.")
 110
 111 (defvar nnspool-history-file "/usr/lib/news/history"
 112   "*Local news history file.")
 113
 114 (defvar nnspool-large-newsgroup 50
 115   "*The number of the articles which indicates a large newsgroup.
 116 If the number of the articles is greater than the value, verbose
 117 messages will be shown to indicate the current status.")
 118
 119 \f
 120
 121 (defconst nnspool-version "nnspool 2.0"
 122   "Version numbers of this version of NNSPOOL.")
 123
 124 (defvar nnspool-current-directory nil
 125   "Current news group directory.")
 126
 127 (defvar nnspool-status-string "")
 128
 129 \f
 130
 131 ;;; Interface functions.
 132
 133 (defun nnspool-retrieve-headers (sequence &optional newsgroup server)
 134   "Retrieve the headers for the articles in SEQUENCE.
 135 Newsgroup must be selected before calling this function."
 136   (save-excursion
 137     (set-buffer nntp-server-buffer)
 138     (erase-buffer)
 139     (let* ((number (length sequence))
 140            (count 0)
 141            (do-message (and (numberp nnspool-large-newsgroup)
 142                             (> number nnspool-large-newsgroup)))
 143            file beg article)
 144       (nnspool-possibly-change-directory newsgroup)
 145       (while sequence
 146         (setq article (car sequence))
 147         (setq file
 148               (concat nnspool-current-directory (prin1-to-string article)))
 149         (if (file-exists-p file)
 150             (progn
 151               (insert (format "221 %d Article retrieved.\n" article))
 152               (setq beg (point))
 153               (insert-file-contents file)
 154               (goto-char beg)
 155               (search-forward "\n\n" nil t)
 156               (forward-char -1)
 157               (insert ".\n")
 158               (delete-region (point) (point-max))))
 159         (setq sequence (cdr sequence))
 160
 161         (and do-message
 162              (zerop (% (setq count (1+ count)) 20))
 163              (message "NNSPOOL: Receiving headers... %d%%"
 164                       (/ (* count 100) number))))
 165
 166       (if do-message (message "NNSPOOL: Receiving headers... done"))
 167
 168       ;; Fold continuation lines.
 169       (goto-char 1)
 170       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 171         (replace-match " " t t))
 172       'headers)))
 173
 174 (defun nnspool-open-server (host &optional service)
 175   "Open local spool."
 176   (setq nnspool-status-string "")
 177   (cond ((and (file-directory-p nnspool-spool-directory)
 178               (file-exists-p nnspool-active-file))
 179          (nnspool-open-server-internal host service))
 180         (t
 181          (setq nnspool-status-string
 182                (format "NNSPOOL: cannot talk to %s." host))
 183          nil)))
 184
 185 (defun nnspool-close-server (&optional server)
 186   "Close news server."
 187   (nnspool-close-server-internal))
 188
 189 (fset 'nnspool-request-quit (symbol-function 'nnspool-close-server))
 190
 191 (defun nnspool-server-opened (&optional server)
 192   "Return server process status, T or NIL.
 193 If the stream is opened, return T, otherwise return NIL."
 194   (and nntp-server-buffer
 195        (get-buffer nntp-server-buffer)))
 196
 197 (defun nnspool-status-message ()
 198   "Return server status response as string."
 199   nnspool-status-string)
 200
 201 (defun nnspool-request-article (id &optional newsgroup server buffer)
 202   "Select article by message ID (or number)."
 203   (nnspool-possibly-change-directory newsgroup)
 204   (let ((file (if (stringp id)
 205                   (nnspool-find-article-by-message-id id)
 206                 (concat nnspool-current-directory (prin1-to-string id))))
 207         (nntp-server-buffer (or buffer nntp-server-buffer)))
 208     (if (and (stringp file)
 209              (file-exists-p file)
 210              (not (file-directory-p file)))
 211         (save-excursion
 212           (nnspool-find-file file)))))
 213
 214 (defun nnspool-request-body (id &optional newsgroup server)
 215   "Select article body by message ID (or number)."
 216   (nnspool-possibly-change-directory newsgroup)
 217   (if (nnspool-request-article id)
 218       (save-excursion
 219         (set-buffer nntp-server-buffer)
 220         (goto-char (point-min))
 221         (if (search-forward "\n\n" nil t)
 222             (delete-region (point-min) (point)))
 223         t)))
 224
 225 (defun nnspool-request-head (id &optional newsgroup server)
 226   "Select article head by message ID (or number)."
 227   (nnspool-possibly-change-directory newsgroup)
 228   (if (nnspool-request-article id)
 229       (save-excursion
 230         (set-buffer nntp-server-buffer)
 231         (goto-char (point-min))
 232         (if (search-forward "\n\n" nil t)
 233             (delete-region (1- (point)) (point-max)))
 234         t)))
 235
 236 (defun nnspool-request-group (group &optional server dont-check)
 237   "Select news GROUP."
 238   (let ((pathname (nnspool-article-pathname
 239                    (nnspool-replace-chars-in-string group ?. ?/)))
 240         dir)
 241     (if (file-directory-p pathname)
 242         (progn
 243           (setq nnspool-current-directory pathname)
 244           (if (not dont-check)
 245               (progn
 246                 (setq dir (directory-files pathname nil "^[0-9]+$" t))
 247                 ;; yes, completely empty spool directories *are* possible
 248                 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
 249                 (and dir
 250                     (setq dir
 251                           (sort
 252                            (mapcar
 253                             (function
 254                              (lambda (name)
 255                                (string-to-int name)))
 256                             dir)
 257                            '<)))
 258                 (save-excursion
 259                   (set-buffer nntp-server-buffer)
 260                   (erase-buffer)
 261                   (if dir
 262                       (insert
 263                        (format "211 %d %d %d %s\n" (length dir) (car dir)
 264                                (progn (while (cdr dir) (setq dir (cdr dir)))
 265                                       (car dir))
 266                                group))
 267                     (insert (format "211 0 0 0 %s\n" group))))))
 268           t))))
 269
 270 (defun nnspool-request-list (&optional server)
 271   "List active newsgoups."
 272   (save-excursion
 273     (nnspool-find-file nnspool-active-file)))
 274
 275 (defun nnspool-request-list-newsgroups (&optional server)
 276   "List newsgroups (defined in NNTP2)."
 277   (save-excursion
 278     (nnspool-find-file nnspool-newsgroups-file)))
 279
 280 (defun nnspool-request-list-distributions (&optional server)
 281   "List distributions (defined in NNTP2)."
 282   (save-excursion
 283     (nnspool-find-file nnspool-distributions-file)))
 284
 285 (defun nnspool-request-post (&optional server)
 286   "Post a new news in current buffer."
 287   (save-excursion
 288     ;; We have to work in the server buffer because of NEmacs hack.
 289     (copy-to-buffer nntp-server-buffer (point-min) (point-max))
 290     (set-buffer nntp-server-buffer)
 291     (apply (function call-process-region)
 292            (point-min) (point-max)
 293            nnspool-inews-program 'delete t nil nnspool-inews-switches)
 294     (prog1
 295         (or (zerop (buffer-size))
 296             ;; If inews returns strings, it must be error message
 297             ;;  unless SPOOLNEWS is defined.
 298             ;; This condition is very weak, but there is no good rule
 299             ;;  identifying errors when SPOOLNEWS is defined.
 300             ;; Suggested by ohm@kaba.junet.
 301             (string-match "spooled" (buffer-string)))
 302       ;; Make status message by unfolding lines.
 303       (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
 304       (setq nnspool-status-string (buffer-string))
 305       (erase-buffer))))
 306
 307 (fset 'nnspool-request-post-buffer 'nntp-request-post-buffer)
 308
 309 \f
 310 ;;; Low-Level Interface.
 311
 312 (defun nnspool-open-server-internal (host &optional service)
 313   "Open connection to news server on HOST by SERVICE (default is nntp)."
 314   (save-excursion
 315     ;; Initialize communication buffer.
 316     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
 317     (set-buffer nntp-server-buffer)
 318     (buffer-disable-undo (current-buffer))
 319     (erase-buffer)
 320     (kill-all-local-variables)
 321     (setq case-fold-search t)           ;Should ignore case.
 322     t))
 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
 329 (defun nnspool-find-article-by-message-id (id)
 330   "Return full pathname of an article identified by message-ID."
 331   (save-excursion
 332     (let ((buffer (get-file-buffer nnspool-history-file)))
 333       (if buffer
 334           (set-buffer buffer)
 335         ;; Finding history file may take lots of time.
 336         (message "Reading history file...")
 337         (set-buffer (find-file-noselect nnspool-history-file))
 338         (message "Reading history file... done")))
 339     ;; Search from end of the file. I think this is much faster than
 340     ;; do from the beginning of the file.
 341     (goto-char (point-max))
 342     (if (re-search-backward
 343          (concat "^" (regexp-quote id)
 344                  "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
 345         (let ((group (buffer-substring (match-beginning 1) (match-end 1)))
 346               (number (buffer-substring (match-beginning 2) (match-end 2))))
 347           (concat (nnspool-article-pathname
 348                    (nnspool-replace-chars-in-string group ?. ?/))
 349                   number)))))
 350
 351 (defun nnspool-find-file (file)
 352   "Insert FILE in server buffer safely."
 353   (set-buffer nntp-server-buffer)
 354   (erase-buffer)
 355   (condition-case ()
 356       (progn (insert-file-contents file) t)
 357     (file-error nil)))
 358
 359 (defun nnspool-possibly-change-directory (newsgroup)
 360   (if newsgroup
 361       (let ((pathname (nnspool-article-pathname
 362                        (nnspool-replace-chars-in-string newsgroup ?. ?/))))
 363         (if (file-directory-p pathname)
 364             (setq nnspool-current-directory pathname)
 365           (error "No such newsgroup: %s" newsgroup)))))
 366
 367 (defun nnspool-article-pathname (group)
 368   "Make pathname for GROUP."
 369   (concat (file-name-as-directory nnspool-spool-directory) group "/"))
 370
 371 (defun nnspool-replace-chars-in-string (string from to)
 372   "Replace characters in STRING from FROM to TO."
 373   (let ((string (substring string 0))   ;Copy string.
 374         (len (length string))
 375         (idx 0))
 376     ;; Replace all occurrences of FROM with TO.
 377     (while (< idx len)
 378       (if (= (aref string idx) from)
 379           (aset string idx to))
 380       (setq idx (1+ idx)))
 381     string))
 382
 383 (provide 'nnspool)
 384
 385 ;;; nnspool.el ends here