;;; url-util.el --- Miscellaneous helper routines for URL library
;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
;;
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
-;;
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'url-parse)
+(eval-when-compile (require 'cl))
(autoload 'timezone-parse-date "timezone")
(autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-header-extract "mailheader")
;;;###autoload
(defun url-get-normalized-date (&optional specified-time)
- "Return a 'real' date string that most HTTP servers can understand."
- (require 'timezone)
- (let* ((raw (if specified-time (current-time-string specified-time)
- (current-time-string)))
- (gmt (timezone-make-date-arpa-standard raw
- (current-time-zone)
- "GMT"))
- (parsed (timezone-parse-date gmt))
- (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist)))
- (year nil)
- (month (car
- (rassoc
- (string-to-number (aref parsed 1)) url-monthabbrev-alist)))
- )
- (setq day (or (car-safe (rassoc day url-weekday-alist))
- (substring raw 0 3))
- year (aref parsed 0))
- ;; This is needed for plexus servers, or the server will hang trying to
- ;; parse the if-modified-since header. Hopefully, I can take this out
- ;; soon.
- (if (and year (> (length year) 2))
- (setq year (substring year -2 nil)))
-
- (concat day ", " (aref parsed 2) "-" month "-" year " "
- (aref parsed 3) " " (or (aref parsed 4)
- (concat "[" (nth 1 (current-time-zone))
- "]")))))
+ "Return a 'real' date string that most HTTP servers can understand."
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y %T GMT"
+ (or specified-time (current-time)) t)))
;;;###autoload
(defun url-eat-trailing-space (x)
(set (make-local-variable 'url-current-mime-headers)
(mail-header-extract)))))
+(defun url-make-private-file (file)
+ "Make FILE only readable and writable by the current user.
+Creates FILE and its parent directories if they do not exist."
+ (let ((dir (file-name-directory file)))
+ (when dir
+ ;; For historical reasons.
+ (make-directory dir t)))
+ ;; Based on doc-view-make-safe-dir.
+ (condition-case nil
+ (let ((umask (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes #o0600)
+ (with-temp-buffer
+ (write-region (point-min) (point-max)
+ file nil 'silent nil 'excl)))
+ (set-default-file-modes umask)))
+ (file-already-exists
+ (if (file-symlink-p file)
+ (error "Danger: `%s' is a symbolic link" file))
+ (set-file-modes file #o0600))))
+
(provide 'url-util)
;; arch-tag: 24352abc-5a5a-412e-90cd-313b26bed5c9