1;;; nnspool.el --- spool access for GNU Emacs 2 3;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998, 4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 7;; Lars Magne Ingebrigtsen <larsi@gnus.org> 8;; Keywords: news 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;;; Code: 30 31(require 'nnheader) 32(require 'nntp) 33(require 'nnoo) 34(eval-when-compile (require 'cl)) 35 36(nnoo-declare nnspool) 37 38(defvoo nnspool-inews-program news-inews-program 39 "Program to post news. 40This is most commonly `inews' or `injnews'.") 41 42(defvoo nnspool-inews-switches '("-h" "-S") 43 "Switches for nnspool-request-post to pass to `inews' for posting news. 44If you are using Cnews, you probably should set this variable to nil.") 45 46(defvoo nnspool-spool-directory 47 (file-name-as-directory (if (boundp 'news-directory) 48 (symbol-value 'news-directory) 49 news-path)) 50 "Local news spool directory.") 51 52(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") 53 "Local news nov directory.") 54 55(defvoo nnspool-lib-dir 56 (if (file-exists-p "/usr/lib/news/active") 57 "/usr/lib/news/" 58 "/var/lib/news/") 59 "Where the local news library files are stored.") 60 61(defvoo nnspool-active-file (concat nnspool-lib-dir "active") 62 "Local news active file.") 63 64(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") 65 "Local news newsgroups file.") 66 67(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat") 68 "Local news distributions file.") 69 70(defvoo nnspool-history-file (concat nnspool-lib-dir "history") 71 "Local news history file.") 72 73(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times") 74 "Local news active date file.") 75 76(defvoo nnspool-large-newsgroup 50 77 "The number of articles which indicates a large newsgroup. 78If the number of articles is greater than the value, verbose 79messages will be shown to indicate the current status.") 80 81(defvoo nnspool-nov-is-evil nil 82 "Non-nil means that nnspool will never return NOV lines instead of headers.") 83 84(defconst nnspool-sift-nov-with-sed nil 85 "If non-nil, use sed to get the relevant portion from the overview file. 86If nil, nnspool will load the entire file into a buffer and process it 87there.") 88 89(defvoo nnspool-rejected-article-hook nil 90 "*A hook that will be run when an article has been rejected by the server.") 91 92(defvoo nnspool-file-coding-system nnheader-file-coding-system 93 "Coding system for nnspool.") 94 95 96 97(defconst nnspool-version "nnspool 2.0" 98 "Version numbers of this version of NNSPOOL.") 99 100(defvoo nnspool-current-directory nil 101 "Current news group directory.") 102 103(defvoo nnspool-current-group nil) 104(defvoo nnspool-status-string "") 105 106 107;;; Interface functions. 108 109(nnoo-define-basics nnspool) 110 111(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) 112 "Retrieve the headers of ARTICLES." 113 (save-excursion 114 (set-buffer nntp-server-buffer) 115 (erase-buffer) 116 (when (nnspool-possibly-change-directory group) 117 (let* ((number (length articles)) 118 (count 0) 119 (default-directory nnspool-current-directory) 120 (do-message (and (numberp nnspool-large-newsgroup) 121 (> number nnspool-large-newsgroup))) 122 (nnheader-file-coding-system nnspool-file-coding-system) 123 file beg article ag) 124 (if (and (numberp (car articles)) 125 (nnspool-retrieve-headers-with-nov articles fetch-old)) 126 ;; We successfully retrieved the NOV headers. 127 'nov 128 ;; No NOV headers here, so we do it the hard way. 129 (while (setq article (pop articles)) 130 (if (stringp article) 131 ;; This is a Message-ID. 132 (setq ag (nnspool-find-id article) 133 file (and ag (nnspool-article-pathname 134 (car ag) (cdr ag))) 135 article (cdr ag)) 136 ;; This is an article in the current group. 137 (setq file (int-to-string article))) 138 ;; Insert the head of the article. 139 (when (and file 140 (file-exists-p file)) 141 (insert "221 ") 142 (princ article (current-buffer)) 143 (insert " Article retrieved.\n") 144 (setq beg (point)) 145 (inline (nnheader-insert-head file)) 146 (goto-char beg) 147 (if (search-forward "\n\n" nil t) 148 (progn 149 (forward-char -1) 150 (insert ".\n")) 151 (goto-char (point-max)) 152 (if (bolp) 153 (insert ".\n") 154 (insert "\n.\n"))) 155 (delete-region (point) (point-max))) 156 157 (and do-message 158 (zerop (% (incf count) 20)) 159 (nnheader-message 5 "nnspool: Receiving headers... %d%%" 160 (/ (* count 100) number)))) 161 162 (when do-message 163 (nnheader-message 5 "nnspool: Receiving headers...done")) 164 165 ;; Fold continuation lines. 166 (nnheader-fold-continuation-lines) 167 'headers))))) 168 169(deffoo nnspool-open-server (server &optional defs) 170 (nnoo-change-server 'nnspool server defs) 171 (cond 172 ((not (file-exists-p nnspool-spool-directory)) 173 (nnspool-close-server) 174 (nnheader-report 'nnspool "Spool directory doesn't exist: %s" 175 nnspool-spool-directory)) 176 ((not (file-directory-p 177 (directory-file-name 178 (file-truename nnspool-spool-directory)))) 179 (nnspool-close-server) 180 (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) 181 ((not (file-exists-p nnspool-active-file)) 182 (nnheader-report 'nnspool "The active file doesn't exist: %s" 183 nnspool-active-file)) 184 (t 185 (nnheader-report 'nnspool "Opened server %s using directory %s" 186 server nnspool-spool-directory) 187 t))) 188 189(deffoo nnspool-request-article (id &optional group server buffer) 190 "Select article by message ID (or number)." 191 (nnspool-possibly-change-directory group) 192 (let ((nntp-server-buffer (or buffer nntp-server-buffer)) 193 file ag) 194 (if (stringp id) 195 ;; This is a Message-ID. 196 (when (setq ag (nnspool-find-id id)) 197 (setq file (nnspool-article-pathname (car ag) (cdr ag)))) 198 (setq file (nnspool-article-pathname nnspool-current-group id))) 199 (and file 200 (file-exists-p file) 201 (not (file-directory-p file)) 202 (save-excursion (nnspool-find-file file)) 203 ;; We return the article number and group name. 204 (if (numberp id) 205 (cons nnspool-current-group id) 206 ag)))) 207 208(deffoo nnspool-request-body (id &optional group server) 209 "Select article body by message ID (or number)." 210 (nnspool-possibly-change-directory group) 211 (let ((res (nnspool-request-article id))) 212 (when res 213 (save-excursion 214 (set-buffer nntp-server-buffer) 215 (goto-char (point-min)) 216 (when (search-forward "\n\n" nil t) 217 (delete-region (point-min) (point))) 218 res)))) 219 220(deffoo nnspool-request-head (id &optional group server) 221 "Select article head by message ID (or number)." 222 (nnspool-possibly-change-directory group) 223 (let ((res (nnspool-request-article id))) 224 (when res 225 (save-excursion 226 (set-buffer nntp-server-buffer) 227 (goto-char (point-min)) 228 (when (search-forward "\n\n" nil t) 229 (delete-region (1- (point)) (point-max))) 230 (nnheader-fold-continuation-lines))) 231 res)) 232 233(deffoo nnspool-request-group (group &optional server dont-check) 234 "Select news GROUP." 235 (let ((pathname (nnspool-article-pathname group)) 236 dir) 237 (if (not (file-directory-p pathname)) 238 (nnheader-report 239 'nnspool "Invalid group name (no such directory): %s" group) 240 (setq nnspool-current-directory pathname) 241 (nnheader-report 'nnspool "Selected group %s" group) 242 (if dont-check 243 (progn 244 (nnheader-report 'nnspool "Selected group %s" group) 245 t) 246 ;; Yes, completely empty spool directories *are* possible. 247 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> 248 (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) 249 (setq dir 250 (sort (mapcar (lambda (name) (string-to-number name)) dir) '<))) 251 (if dir 252 (nnheader-insert 253 "211 %d %d %d %s\n" (length dir) (car dir) 254 (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) 255 group) 256 (nnheader-report 'nnspool "Empty group %s" group) 257 (nnheader-insert "211 0 0 0 %s\n" group)))))) 258 259(deffoo nnspool-request-type (group &optional article) 260 'news) 261 262(deffoo nnspool-close-group (group &optional server) 263 t) 264 265(deffoo nnspool-request-list (&optional server) 266 "List active newsgroups." 267 (save-excursion 268 (or (nnspool-find-file nnspool-active-file) 269 (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) 270 271(deffoo nnspool-request-list-newsgroups (&optional server) 272 "List newsgroups (defined in NNTP2)." 273 (save-excursion 274 (or (nnspool-find-file nnspool-newsgroups-file) 275 (nnheader-report 'nnspool (nnheader-file-error 276 nnspool-newsgroups-file))))) 277 278(deffoo nnspool-request-list-distributions (&optional server) 279 "List distributions (defined in NNTP2)." 280 (save-excursion 281 (or (nnspool-find-file nnspool-distributions-file) 282 (nnheader-report 'nnspool (nnheader-file-error 283 nnspool-distributions-file))))) 284 285;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. 286(deffoo nnspool-request-newgroups (date &optional server) 287 "List groups created after DATE." 288 (if (nnspool-find-file nnspool-active-times-file) 289 (save-excursion 290 ;; Find the last valid line. 291 (goto-char (point-max)) 292 (while (and (not (looking-at 293 "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) 294 (zerop (forward-line -1)))) 295 (let ((seconds (time-to-seconds (date-to-time date))) 296 groups) 297 ;; Go through lines and add the latest groups to a list. 298 (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") 299 (progn 300 ;; We insert a .0 to make the list reader 301 ;; interpret the number as a float. It is far 302 ;; too big to be stored in a lisp integer. 303 (goto-char (1- (match-end 0))) 304 (insert ".0") 305 (> (progn 306 (goto-char (match-end 1)) 307 (read (current-buffer))) 308 seconds)) 309 (push (buffer-substring 310 (match-beginning 1) (match-end 1)) 311 groups) 312 (zerop (forward-line -1)))) 313 (erase-buffer) 314 (while groups 315 (insert (car groups) " 0 0 y\n") 316 (setq groups (cdr groups)))) 317 t) 318 nil)) 319 320(deffoo nnspool-request-post (&optional server) 321 "Post a new news in current buffer." 322 (save-excursion 323 (let* ((process-connection-type nil) ; t bugs out on Solaris 324 (inews-buffer (generate-new-buffer " *nnspool post*")) 325 (proc 326 (condition-case err 327 (apply 'start-process "*nnspool inews*" inews-buffer 328 nnspool-inews-program nnspool-inews-switches) 329 (error 330 (nnheader-report 'nnspool "inews error: %S" err))))) 331 (if (not proc) 332 ;; The inews program failed. 333 () 334 (nnheader-report 'nnspool "") 335 (set-process-sentinel proc 'nnspool-inews-sentinel) 336 (mm-with-unibyte-current-buffer 337 (process-send-region proc (point-min) (point-max))) 338 ;; We slap a condition-case around this, because the process may 339 ;; have exited already... 340 (ignore-errors 341 (process-send-eof proc)) 342 t)))) 343 344 345 346;;; Internal functions. 347 348(defun nnspool-inews-sentinel (proc status) 349 (save-excursion 350 (set-buffer (process-buffer proc)) 351 (goto-char (point-min)) 352 (if (or (zerop (buffer-size)) 353 (search-forward "spooled" nil t)) 354 (kill-buffer (current-buffer)) 355 ;; Make status message by folding lines. 356 (while (re-search-forward "[ \t\n]+" nil t) 357 (replace-match " " t t)) 358 (nnheader-report 'nnspool "%s" (buffer-string)) 359 (nnheader-message 5 "nnspool: %s" nnspool-status-string) 360 (ding) 361 (run-hooks 'nnspool-rejected-article-hook)))) 362 363(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) 364 (if (or gnus-nov-is-evil nnspool-nov-is-evil) 365 nil 366 (let ((nov (nnheader-group-pathname 367 nnspool-current-group nnspool-nov-directory ".overview")) 368 (arts articles) 369 (nnheader-file-coding-system nnspool-file-coding-system) 370 last) 371 (if (not (file-exists-p nov)) 372 () 373 (save-excursion 374 (set-buffer nntp-server-buffer) 375 (erase-buffer) 376 (if nnspool-sift-nov-with-sed 377 (nnspool-sift-nov-with-sed articles nov) 378 (nnheader-insert-file-contents nov) 379 (if (and fetch-old 380 (not (numberp fetch-old))) 381 t ; We want all the headers. 382 (ignore-errors 383 ;; Delete unwanted NOV lines. 384 (nnheader-nov-delete-outside-range 385 (if fetch-old (max 1 (- (car articles) fetch-old)) 386 (car articles)) 387 (car (last articles))) 388 ;; If the buffer is empty, this wasn't very successful. 389 (unless (zerop (buffer-size)) 390 ;; We check what the last article number was. 391 ;; The NOV file may be out of sync with the articles 392 ;; in the group. 393 (forward-line -1) 394 (setq last (read (current-buffer))) 395 (if (= last (car articles)) 396 ;; Yup, it's all there. 397 t 398 ;; Perhaps not. We try to find the missing articles. 399 (while (and arts 400 (<= last (car arts))) 401 (pop arts)) 402 ;; The articles in `arts' are missing from the buffer. 403 (while arts 404 (nnspool-insert-nov-head (pop arts))) 405 t)))))))))) 406 407(defun nnspool-insert-nov-head (article) 408 "Read the head of ARTICLE, convert to NOV headers, and insert." 409 (save-excursion 410 (let ((cur (current-buffer)) 411 buf) 412 (setq buf (nnheader-set-temp-buffer " *nnspool head*")) 413 (when (nnheader-insert-head 414 (nnspool-article-pathname nnspool-current-group article)) 415 (nnheader-insert-article-line article) 416 (let ((headers (nnheader-parse-head))) 417 (set-buffer cur) 418 (goto-char (point-max)) 419 (nnheader-insert-nov headers))) 420 (kill-buffer buf)))) 421 422(defun nnspool-sift-nov-with-sed (articles file) 423 (let ((first (car articles)) 424 (last (progn (while (cdr articles) (setq articles (cdr articles))) 425 (car articles)))) 426 (call-process "awk" nil t nil 427 (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" 428 (1- first) (1+ last)) 429 file))) 430 431;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). 432;; Find out what group an article identified by a Message-ID is in. 433(defun nnspool-find-id (id) 434 (save-excursion 435 (set-buffer (get-buffer-create " *nnspool work*")) 436 (erase-buffer) 437 (ignore-errors 438 (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) 439 (goto-char (point-min)) 440 (prog1 441 (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") 442 (cons (match-string 1) (string-to-number (match-string 2)))) 443 (kill-buffer (current-buffer))))) 444 445(defun nnspool-find-file (file) 446 "Insert FILE in server buffer safely." 447 (set-buffer nntp-server-buffer) 448 (erase-buffer) 449 (condition-case () 450 (let ((coding-system-for-read nnspool-file-coding-system)) 451 (mm-insert-file-contents file) 452 t) 453 (file-error nil))) 454 455(defun nnspool-possibly-change-directory (group) 456 (if (not group) 457 t 458 (let ((pathname (nnspool-article-pathname group))) 459 (if (file-directory-p pathname) 460 (setq nnspool-current-directory pathname 461 nnspool-current-group group) 462 (nnheader-report 'nnspool "No such newsgroup: %s" group))))) 463 464(defun nnspool-article-pathname (group &optional article) 465 "Find the file name for GROUP." 466 (nnheader-group-pathname group nnspool-spool-directory article)) 467 468(provide 'nnspool) 469 470;;; arch-tag: bdac8d27-2934-4eee-bad0-49e6b90c0d05 471;;; nnspool.el ends here 472