1 ;;; url-news.el --- News Uniform Resource Locator retrieval code
3 ;; Copyright (C) 1996-1999, 2004-2014 Free Software Foundation, Inc.
5 ;; Keywords: comm, data, processes
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 (autoload 'url-warn "url")
29 (autoload 'gnus-group-read-ephemeral-group "gnus-group")
32 ;;; (defgroup url-news nil
33 ;;; "News related options."
36 (defun url-news-open-host (host port user pass)
37 (if (fboundp 'nnheader-init-server-buffer)
38 (nnheader-init-server-buffer))
39 (nntp-open-server host (list port))
42 (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
43 (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
44 (if (not (nntp-server-opened host))
45 (url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
48 (defun url-news-fetch-message-id (host message-id)
49 (let ((buf (generate-new-buffer " *url-news*")))
50 (if (eq ?> (aref message-id (1- (length message-id))))
52 (setq message-id (concat "<" message-id ">")))
53 (if (cdr-safe (nntp-request-article message-id nil host buf))
54 ;; Successfully retrieved the article
56 (with-current-buffer buf
57 (insert "Content-type: text/html\n\n"
60 " <title>Error</title>\n"
64 " <h1>Error requesting article...</h1>\n"
66 " The status message returned by the NNTP server was:"
73 " If you If you feel this is an error, <a href=\""
74 "mailto:" url-bug-address "\">send mail</a>\n"
79 "<!-- Automatically generated by URL v" url-version " -->\n"
83 (defvar gnus-group-buffer)
85 (defun url-news-fetch-newsgroup (newsgroup host)
86 (if (string-match "^/+" newsgroup)
87 (setq newsgroup (substring newsgroup (match-end 0))))
88 (if (string-match "/+$" newsgroup)
89 (setq newsgroup (substring newsgroup 0 (match-beginning 0))))
91 ;; This saves us from checking new news if Gnus is already running
92 ;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME
93 (if (or (not (get-buffer gnus-group-buffer))
94 (with-current-buffer gnus-group-buffer
95 (not (eq major-mode 'gnus-group-mode))))
97 (set-buffer gnus-group-buffer)
98 (goto-char (point-min))
99 (gnus-group-read-ephemeral-group newsgroup
101 (list 'nntp-open-connection-function
102 nntp-open-connection-function))
104 (cons (current-buffer) 'browse)))
107 (defun url-news (url)
108 ;; Find a news reference
109 (let* ((host (or (url-host url) url-news-server))
110 (port (url-port url))
111 (article-brackets nil)
113 (article (url-unhex-string (url-filename url))))
114 (url-news-open-host host port (url-user url) (url-password url))
116 ((string-match "@" article) ; Its a specific article
117 (setq buf (url-news-fetch-message-id host article)))
118 ((string= article "") ; List all newsgroups
121 (url-news-fetch-newsgroup article host)))
125 (defun url-snews (url)
126 (let ((nntp-open-connection-function (if (eq 'ssl url-gateway-method)
127 'nntp-open-ssl-stream
128 'nntp-open-tls-stream)))
133 ;;; url-news.el ends here