Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cl-tar
cl-tar-file
Commits
375a9ec6
Commit
375a9ec6
authored
Sep 06, 2021
by
Eric Timmons
Browse files
Rename ARCHIVE-ENTRY-TYPE -> ENTRY-TYPE
parent
b1af77e3
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/archive.lisp
View file @
375a9ec6
...
...
@@ -35,11 +35,11 @@
(
:documentation
"Base class of a tar archive."
))
(
defgeneric
archive-
header-type
(
archive
)
(
defgeneric
header-type
(
archive
)
(
:documentation
"Given a
n archiv
e, return a symbol naming the header class."
))
"Given a
tar-fil
e, return a symbol naming the header class."
))
(
defgeneric
archive-
entry-type
(
archive
header
)
(
defgeneric
entry-type
(
archive
header
)
(
:documentation
"Return a symbol naming the class to use to represent the entry for HEADER in ARCHIVE."
))
...
...
@@ -138,8 +138,8 @@ Further operations on the archive are undefined."
(
error
"Corrupt archive"
))))
(
if
(
null-block-p
buffer
0
)
nil
(
let
((
header
(
read-header-from-buffer
(
archive-
header-type
archive
)
buffer
:start
0
)))
(
make-instance
(
archive-
entry-type
archive
header
)
(
let
((
header
(
read-header-from-buffer
(
header-type
archive
)
buffer
:start
0
)))
(
make-instance
(
entry-type
archive
header
)
:archive
archive
:header
header
:start-position
start-position
)))))
...
...
src/entry.lisp
View file @
375a9ec6
...
...
@@ -5,9 +5,9 @@
(
in-package
#:tar-file
)
(
defclass
entry
()
((
ar
chiv
e
:initarg
:ar
chiv
e
:reader
entry-ar
chiv
e
)
((
t
ar
-fil
e
:initarg
:
t
ar
-fil
e
:reader
entry-
t
ar
-fil
e
)
(
start-position
:initarg
:start-position
:reader
start-position
...
...
@@ -25,7 +25,7 @@
(
:documentation
"A regular file."
))
(
defun
write-file-entry
(
ar
chiv
e
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
size
data
)
(
defun
write-file-entry
(
t
ar
-fil
e
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
size
data
)
(
declare
(
ignore
uname
gname
mode
mtime
uid
gid
))
;; Compute the size when necessary.
(
when
(
null
size
)
...
...
@@ -40,7 +40,7 @@
(
push
size
args
)
(
push
:size
args
))
(
let
((
header
(
apply
#'
make-instance
(
archive-
header-type
archive
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
archive
)
:name
name
:typeflag
(
if
(
typep
archive
'v7-archive
)
+tar-regular-alternate-file+
...
...
@@ -57,7 +57,7 @@
(
defun
write-hard-link-entry
(
archive
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
linkname
)
(
declare
(
ignore
uname
gname
mode
mtime
uid
gid
linkname
))
(
let
((
header
(
apply
#'
make-instance
(
archive-
header-type
archive
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
archive
)
:name
name
:typeflag
+tar-hard-link+
args
))
...
...
@@ -72,7 +72,7 @@
(
defun
write-symbolic-link-entry
(
archive
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
linkname
)
(
declare
(
ignore
uname
gname
mode
mtime
uid
gid
linkname
))
(
let
((
header
(
apply
#'
make-instance
(
archive-
header-type
archive
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
archive
)
:name
name
:typeflag
+tar-symbolic-link+
args
))
...
...
@@ -88,7 +88,7 @@
(
defun
write-character-device-entry
(
archive
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
devmajor
devminor
)
(
declare
(
ignore
uname
gname
mode
mtime
uid
gid
devmajor
devminor
))
(
let
((
header
(
apply
#'
make-instance
(
archive-
header-type
archive
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
archive
)
:name
name
:typeflag
+tar-character-device+
args
))
...
...
@@ -104,7 +104,7 @@
(
defun
write-block-device-entry
(
archive
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
devmajor
devminor
)
(
declare
(
ignore
uname
gname
mode
mtime
uid
gid
devmajor
devminor
))
(
let
((
header
(
apply
#'
make-instance
(
archive-
header-type
archive
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
archive
)
:name
name
:typeflag
+tar-block-device+
args
))
...
...
@@ -124,7 +124,7 @@
(
defun
write-fifo-entry
(
archive
name
&rest
args
&key
uname
gname
mode
mtime
uid
gid
)
(
declare
(
ignore
uname
gname
mode
mtime
uid
gid
))
(
let
((
header
(
apply
#'
make-instance
(
archive-
header-type
archive
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
archive
)
:name
name
:typeflag
+tar-fifo-device+
args
))
...
...
src/external-macros.lisp
View file @
375a9ec6
...
...
@@ -61,8 +61,8 @@
(
defmacro
do-entries
((
entry
archive
&optional
result
)
&body
body
)
"Iterate over the entries in ARCHIVE. For each entry, ENTRY is bound to
an ARCHIVE-
ENTRY representing the entry. RESULT is used as in DOTIMES."
"Iterate over the entries in ARCHIVE. For each entry, ENTRY is bound to
an
ENTRY representing the entry. RESULT is used as in DOTIMES."
(
let
((
archive-var
(
gensym
)))
`
(
let
((
,
archive-var
,
archive
))
(
do
((
,
entry
(
read-entry
,
archive-var
)
...
...
src/gnu.lisp
View file @
375a9ec6
...
...
@@ -48,7 +48,7 @@
(
defclass
gnu-archive
(
archive
)
())
(
defmethod
archive-
header-type
((
archive
gnu-archive
))
(
defmethod
header-type
((
archive
gnu-archive
))
'gnu-header
)
(
defun
detect-gnu-archive
(
buffer
)
...
...
@@ -60,7 +60,7 @@
(
register-type-detector
'detect-gnu-archive
)
(
defmethod
archive-
entry-type
((
archive
gnu-archive
)
header
)
(
defmethod
entry-type
((
archive
gnu-archive
)
header
)
(
alexandria:switch
((
typeflag
header
))
(
+tar-regular-file+
'file-entry
)
...
...
src/ustar.lisp
View file @
375a9ec6
...
...
@@ -37,7 +37,7 @@
(
defclass
ustar-archive
(
archive
)
())
(
defmethod
archive-
header-type
((
archive
ustar-archive
))
(
defmethod
header-type
((
archive
ustar-archive
))
'ustar-header
)
(
defun
detect-ustar-archive
(
buffer
)
...
...
@@ -49,7 +49,7 @@
(
register-type-detector
'detect-ustar-archive
)
(
defmethod
archive-
entry-type
((
archive
ustar-archive
)
header
)
(
defmethod
entry-type
((
archive
ustar-archive
)
header
)
(
alexandria:switch
((
typeflag
header
))
(
+tar-regular-file+
'file-entry
)
...
...
src/v7.lisp
View file @
375a9ec6
...
...
@@ -19,10 +19,10 @@
(
defclass
v7-archive
(
archive
)
())
(
defmethod
archive-
header-type
((
archive
v7-archive
))
(
defmethod
header-type
((
archive
v7-archive
))
'v7-header
)
(
defmethod
archive-
entry-type
((
archive
v7-archive
)
header
)
(
defmethod
entry-type
((
archive
v7-archive
)
header
)
(
if
(
alexandria:ends-with
+ascii-/+
(
name
header
))
'directory-entry
(
alexandria:switch
((
typeflag
header
))
...
...
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