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 feel this is an error, M-x report-emacs-bug RET.\n"
78 "<!-- Automatically generated by URL v" url-version
" -->\n"
82 (defvar gnus-group-buffer
)
84 (defun url-news-fetch-newsgroup (newsgroup host
)
85 (if (string-match "^/+" newsgroup
)
86 (setq newsgroup
(substring newsgroup
(match-end 0))))
87 (if (string-match "/+$" newsgroup
)
88 (setq newsgroup
(substring newsgroup
0 (match-beginning 0))))
90 ;; This saves us from checking new news if Gnus is already running
91 ;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME
92 (if (or (not (get-buffer gnus-group-buffer
))
93 (with-current-buffer gnus-group-buffer
94 (not (eq major-mode
'gnus-group-mode
))))
96 (set-buffer gnus-group-buffer
)
97 (goto-char (point-min))
98 (gnus-group-read-ephemeral-group newsgroup
100 (list 'nntp-open-connection-function
101 nntp-open-connection-function
))
103 (cons (current-buffer) 'browse
)))
106 (defun url-news (url)
107 ;; Find a news reference
108 (let* ((host (or (url-host url
) url-news-server
))
109 (port (url-port url
))
110 (article-brackets nil
)
112 (article (url-unhex-string (url-filename url
))))
113 (url-news-open-host host port
(url-user url
) (url-password url
))
115 ((string-match "@" article
) ; Its a specific article
116 (setq buf
(url-news-fetch-message-id host article
)))
117 ((string= article
"") ; List all newsgroups
120 (url-news-fetch-newsgroup article host
)))
124 (defun url-snews (url)
125 (let ((nntp-open-connection-function (if (eq 'ssl url-gateway-method
)
126 'nntp-open-ssl-stream
127 'nntp-open-tls-stream
)))
132 ;;; url-news.el ends here