Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
3c94d7a6
Commit
3c94d7a6
authored
Dec 29, 2012
by
Chong Yidong
Browse files
* emacs-lisp/package.el (package-untar-buffer): Improve integrity check for tarball contents.
parent
af39894a
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
16 additions
and
7 deletions
+16
-7
lisp/ChangeLog
lisp/ChangeLog
+5
-0
lisp/emacs-lisp/package.el
lisp/emacs-lisp/package.el
+11
-7
No files found.
lisp/ChangeLog
View file @
3c94d7a6
2012-12-29 Chong Yidong <cyd@gnu.org>
* emacs-lisp/package.el (package-untar-buffer): Improve integrity
check for the tarball contents.
2012-12-29 Matt Fidler <matt.fidler@alcon.com> (tiny change)
2012-12-29 Matt Fidler <matt.fidler@alcon.com> (tiny change)
* emacs-lisp/package.el (package-untar-buffer): Handle problematic
* emacs-lisp/package.el (package-untar-buffer): Handle problematic
...
...
lisp/emacs-lisp/package.el
View file @
3c94d7a6
...
@@ -596,6 +596,8 @@ EXTRA-PROPERTIES is currently unused."
...
@@ -596,6 +596,8 @@ EXTRA-PROPERTIES is currently unused."
(
defvar
tar-parse-info
)
(
defvar
tar-parse-info
)
(
declare-function
tar-untar-buffer
"tar-mode"
())
(
declare-function
tar-untar-buffer
"tar-mode"
())
(
declare-function
tar-header-name
"tar-mode"
(
tar-header
))
(
declare-function
tar-header-link-type
"tar-mode"
(
tar-header
))
(
defun
package-untar-buffer
(
dir
)
(
defun
package-untar-buffer
(
dir
)
"Untar the current buffer.
"Untar the current buffer.
...
@@ -604,14 +606,16 @@ untar into a directory named DIR; otherwise, signal an error."
...
@@ -604,14 +606,16 @@ untar into a directory named DIR; otherwise, signal an error."
(
require
'tar-mode
)
(
require
'tar-mode
)
(
tar-mode
)
(
tar-mode
)
;; Make sure everything extracts into DIR.
;; Make sure everything extracts into DIR.
(
let
((
regexp
(
concat
"\\`"
(
regexp-quote
dir
)
(
let
((
regexp
(
concat
"\\`"
(
regexp-quote
(
expand-file-name
dir
))
"/"
))
;; Tarballs created by some utilities don't
(
case-fold-search
(
memq
system-type
'
(
windows-nt
ms-dos
cygwin
))))
;; list directories with a trailing slash
;; (Bug#13136).
"\\(/\\|\\'\\)"
)))
(
dolist
(
tar-data
tar-parse-info
)
(
dolist
(
tar-data
tar-parse-info
)
(
unless
(
string-match
regexp
(
aref
tar-data
2
))
(
let
((
name
(
expand-file-name
(
tar-header-name
tar-data
))))
(
error
"Package does not untar cleanly into directory %s/"
dir
))))
(
or
(
string-match
regexp
name
)
;; Tarballs created by some utilities don't list
;; directories with a trailing slash (Bug#13136).
(
and
(
string-equal
dir
name
)
(
eq
(
tar-header-link-type
tar-data
)
5
))
(
error
"Package does not untar cleanly into directory %s/"
dir
)))))
(
tar-untar-buffer
))
(
tar-untar-buffer
))
(
defun
package-unpack
(
package
version
)
(
defun
package-unpack
(
package
version
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment