[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/with-url e975522 2/3: Put the caching functions in
From: |
Lars Ingebrigtsen |
Subject: |
[Emacs-diffs] scratch/with-url e975522 2/3: Put the caching functions into the main file and remove the -cache file |
Date: |
Sun, 22 Jan 2017 20:06:58 +0000 (UTC) |
branch: scratch/with-url
commit e975522f9d055e00228a30d491eec94fe3417f8a
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>
Put the caching functions into the main file and remove the -cache file
It's not going to be very big, anyway.
---
lisp/url/with-url-cache.el | 33 --------------
lisp/url/with-url.el | 102 ++++++++++++++++++++++++++++++++++++++------
2 files changed, 89 insertions(+), 46 deletions(-)
diff --git a/lisp/url/with-url-cache.el b/lisp/url/with-url-cache.el
deleted file mode 100644
index 32f72a4..0000000
--- a/lisp/url/with-url-cache.el
+++ /dev/null
@@ -1,33 +0,0 @@
-;;; with-url-cache.el --- High-Level URL Interface caching -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2017 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <address@hidden>
-;; Keywords: http url
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'url)
-
-
-(provide 'with-url)
-
-;;; with-url.el ends here
diff --git a/lisp/url/with-url.el b/lisp/url/with-url.el
index 20d9e89..16a0697 100644
--- a/lisp/url/with-url.el
+++ b/lisp/url/with-url.el
@@ -30,7 +30,6 @@
(require 'gnutls)
(require 'mm-url)
(require 'url-http)
-(require 'url-cache)
(cl-defstruct url-request
original-url wait timeout read-timeout
@@ -416,8 +415,7 @@ If given, return the value in BUFFER instead."
(list "Host" (puny-encode-string (url-host parsed)))
(list "If-Modified-Since"
(and (memq (url-request-cache req) '(t write))
- (when-let ((tm (url-is-cached (url-request-url
req))))
- (url-get-normalized-date tm)))))))
+ (with-url-cache-time (url-request-url req)))))))
(cl-loop for (name value) in headers
when (and (not (cl-assoc name (url-request-headers req)
:test #'cl-equalp))
@@ -535,9 +533,6 @@ If given, return the value in BUFFER instead."
(cond
;; We got the expected response.
((<= 200 code 299)
- (when (and (memq (url-request-cache req) '(t write))
- (equal (url-request-method req) "GET"))
- (with-url--store-in-cache req))
(with-url--callback process))
;; We don't support proxies.
((eq status 'use-proxy)
@@ -547,7 +542,7 @@ If given, return the value in BUFFER instead."
(url-header 'location)))))
;; The document is in the cache.
((eq status 'not-modified)
- (url-cache-extract (url-cache-create-filename (url-request-url req)))
+ (with-url-get-cache (url-request-url req))
(with-url--parse-headers)
(with-url--callback process))
;; Redirects.
@@ -563,12 +558,6 @@ If given, return the value in BUFFER instead."
(t
(with-url--callback process)))))
-(defun with-url--store-in-cache (req)
- (let ((fname (url-cache-create-filename (url-request-url req))))
- (when (url-cache-prepare fname)
- (let ((coding-system-for-write 'binary))
- (write-region (point-min) (point-max) fname nil 5)))))
-
(defun with-url--callback (process &optional status req)
(let ((req (or req (plist-get (process-plist process) :request))))
(with-current-buffer (url-request-buffer req)
@@ -606,6 +595,10 @@ If given, return the value in BUFFER instead."
(while (search-forward "\r\n" nil t)
(forward-char -1)
(delete-char -1)))
+ (when (and (memq (url-request-cache req) '(t write))
+ (equal (url-request-method req) "GET")
+ (url-okp))
+ (with-url-put-cache (url-request-url req)))
(with-url--possible-callback req))))
(defun with-url--decode-chunked ()
@@ -684,6 +677,89 @@ If given, return the value in BUFFER instead."
(while (not (url-request-finished req))
(sleep-for 0.1))))
+(defun with-url-put-cache (url)
+ "Put the current buffer into a cache designated by URL.
+If the headers don't allow caching, nothing will be done."
+ ;; We store things in the cache if they have a Last-Modified header
+ ;; and they either don't have an Expires header, or it's in the
+ ;; future.
+ (let ((expires nil))
+ (current-buffer)
+ (when (and (url-header 'last-modified)
+ (or (not (url-header 'expires))
+ (progn
+ (setq expires
+ (ignore-errors
+ (apply #'encode-time
+ (parse-time-string (url-header
'expires)))))
+ (or (not expires)
+ (time-less-p (current-time) expires)))))
+ (let ((contents (buffer-string))
+ (buffer (current-buffer)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert "Content-Type: " (or (url-header 'content-type buffer)
+ "text/plain")
+ "\n")
+ (insert "Last-Modified: " (url-header 'last-modified buffer) "\n")
+ ;; If there's no Expires header, we cache for one day.
+ (insert "Expires: "
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y %T %z"
+ (or expires
+ (time-add (current-time)
+ (list 0 (* 60 60 24))))))
+ "\n")
+ (insert "\n")
+ (insert contents)
+ (let ((file (with-url--cache-file-name url)))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (write-region (point-min) (point-max) file nil 'silent)))))))
+
+(defun with-url-cache-time (url)
+ "Return the Last-Modified timestamp for the cached version of URL, if any."
+ (let ((file (with-url--cache-file-name url)))
+ (when (file-exists-p file)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point)))
+ (mail-fetch-field "last-modified")))))
+
+(defun with-url-get-cache (url)
+ (let ((file (with-url--cache-file-name url)))
+ (when (file-exists-p file)
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (let ((expires
+ (progn
+ (narrow-to-region
+ (point) (or (search-forward "\n\n" nil t) (point)))
+ (ignore-errors
+ (apply #'encode-time
+ (parse-time-string
+ (mail-fetch-field "expires")))))))
+ (if (and (null expires)
+ (time-less-p (current-time) expires))
+ t
+ (erase-buffer)
+ nil)))))
+
+(defun with-url--cache-file-name (url)
+ "Return a file name appropriate to store URL.
+It's based in `user-emacs-directory' and is hash-based, and is
+several directories deep to avoid creating extremely large single
+directories."
+ (with-temp-buffer
+ (insert (sha1 url))
+ (goto-char (point-min))
+ (insert (expand-file-name "url" user-emacs-directory) "/cached/")
+ (cl-loop repeat 3
+ do (forward-char 10)
+ (insert "/"))
+ (buffer-string)))
+
(provide 'with-url)
;;; with-url.el ends here