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
ff9442a2
Commit
ff9442a2
authored
Sep 06, 2021
by
Eric Timmons
Browse files
Finish documentation
parent
450d0f1b
Changes
9
Hide whitespace changes
Inline
Side-by-side
src/docs.lisp
0 → 100644
View file @
ff9442a2
;;;; Documentation
;;;;
;;;; This is part of tar-file. See README.org and LICENSE for more information.
(
in-package
#:tar-file
)
(
40ants-doc:defsection
@manual
(
:title
"Tar File Manual"
:export
nil
)
#.
(
uiop:read-file-string
(
asdf:system-relative-pathname
:tar-file
"README.md"
))
(
@opening-tar-files
40ants-doc/locatives:section
)
(
@tar-archive-types
40ants-doc/locatives:section
)
(
@entries
40ants-doc/locatives:section
)
(
@conditions
40ants-doc/locatives:section
))
(
40ants-doc:defsection
@opening-tar-files
(
:title
"Opening and Closing Tar Files"
:export
nil
)
(
*default-header-encoding*
40ants-doc/locatives:variable
)
(
with-open-tar-file
40ants-doc/locatives:macro
)
(
open-tar-file
40ants-doc/locatives:function
)
(
finalize-tar-file
40ants-doc/locatives:generic-function
)
(
close-tar-file
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@tar-archive-types
(
:title
"Tar Archive Types"
:export
nil
)
"There are three different types of tar archives that this system can handle,
with a common base class."
(
tar-file
40ants-doc/locatives:class
)
(
ustar-tar-file
40ants-doc/locatives:class
)
(
gnu-tar-file
40ants-doc/locatives:class
)
(
v7-tar-file
40ants-doc/locatives:class
))
(
40ants-doc:defsection
@entries
(
:title
"Entries"
:export
nil
)
(
do-entries
40ants-doc/locatives:macro
)
(
read-entry
40ants-doc/locatives:generic-function
)
(
entry
40ants-doc/locatives:class
)
(
entry-has-data-p
40ants-doc/locatives:generic-function
)
(
make-entry-stream
40ants-doc/locatives:generic-function
)
(
name
40ants-doc/locatives:generic-function
)
(
size
40ants-doc/locatives:generic-function
)
(
uname
40ants-doc/locatives:generic-function
)
(
gname
40ants-doc/locatives:generic-function
)
(
mode
40ants-doc/locatives:generic-function
)
(
mtime
40ants-doc/locatives:generic-function
)
(
uid
40ants-doc/locatives:generic-function
)
(
gid
40ants-doc/locatives:generic-function
)
(
linkname
40ants-doc/locatives:generic-function
)
(
devmajor
40ants-doc/locatives:generic-function
)
(
devminor
40ants-doc/locatives:generic-function
)
(
prefix
40ants-doc/locatives:generic-function
)
(
atime
40ants-doc/locatives:generic-function
)
(
ctime
40ants-doc/locatives:generic-function
)
(
offset
40ants-doc/locatives:generic-function
)
(
offset-sparse-0
40ants-doc/locatives:generic-function
)
(
numbytes-sparse-0
40ants-doc/locatives:generic-function
)
(
offset-sparse-1
40ants-doc/locatives:generic-function
)
(
numbytes-sparse-1
40ants-doc/locatives:generic-function
)
(
offset-sparse-2
40ants-doc/locatives:generic-function
)
(
numbytes-sparse-2
40ants-doc/locatives:generic-function
)
(
offset-sparse-3
40ants-doc/locatives:generic-function
)
(
numbytes-sparse-3
40ants-doc/locatives:generic-function
)
(
isextended
40ants-doc/locatives:generic-function
)
(
realsize
40ants-doc/locatives:generic-function
)
(
attribute
40ants-doc/locatives:generic-function
)
(
attribute-names
40ants-doc/locatives:generic-function
)
(
do-attributes
40ants-doc/locatives:macro
)
(
@file-entry
40ants-doc/locatives:section
)
(
@symbolic-link-entry
40ants-doc/locatives:section
)
(
@hard-link-entry
40ants-doc/locatives:section
)
(
@character-device-entry
40ants-doc/locatives:section
)
(
@block-device-entry
40ants-doc/locatives:section
)
(
@fifo-entry
40ants-doc/locatives:section
)
(
@directory-entry
40ants-doc/locatives:section
)
(
@pax-extended-attributes-entry
40ants-doc/locatives:section
)
(
@pax-global-attributes-entry
40ants-doc/locatives:section
)
(
@gnu-long-link-name-entry
40ants-doc/locatives:section
)
(
@gnu-long-name-entry
40ants-doc/locatives:section
)
(
@gnu-directory-dump-entry
40ants-doc/locatives:section
)
(
@gnu-sparse-file-entry
40ants-doc/locatives:section
)
(
@gnu-volume-header-name-entry
40ants-doc/locatives:section
)
(
@unknown-entry
40ants-doc/locatives:section
))
(
40ants-doc:defsection
@file-entry
(
:title
"File Entry"
:export
nil
)
(
file-entry
40ants-doc/locatives:class
)
(
write-file-entry
40ants-doc/locatives:generic-function
)
(
entry-file-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@symbolic-link-entry
(
:title
"Symbolic Link Entry"
:export
nil
)
(
symbolic-link-entry
40ants-doc/locatives:class
)
(
write-symbolic-link-entry
40ants-doc/locatives:generic-function
)
(
entry-symbolic-link-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@hard-link-entry
(
:title
"Hard Link Entry"
:export
nil
)
(
hard-link-entry
40ants-doc/locatives:class
)
(
write-hard-link-entry
40ants-doc/locatives:generic-function
)
(
entry-hard-link-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@character-device-entry
(
:title
"Character Device Entry"
:export
nil
)
(
character-device-entry
40ants-doc/locatives:class
)
(
write-character-device-entry
40ants-doc/locatives:generic-function
)
(
entry-character-device-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@block-device-entry
(
:title
"Block Device Entry"
:export
nil
)
(
block-device-entry
40ants-doc/locatives:class
)
(
write-block-device-entry
40ants-doc/locatives:generic-function
)
(
entry-block-device-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@fifo-entry
(
:title
"Fifo Entry"
:export
nil
)
(
fifo-entry
40ants-doc/locatives:class
)
(
write-fifo-entry
40ants-doc/locatives:generic-function
)
(
entry-fifo-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@directory-entry
(
:title
"Directory Entry"
:export
nil
)
(
directory-entry
40ants-doc/locatives:class
)
(
write-directory-entry
40ants-doc/locatives:generic-function
)
(
entry-directory-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@pax-extended-attributes-entry
(
:title
"Pax Extended Attributes Entry"
:export
nil
)
(
pax-extended-attributes-entry
40ants-doc/locatives:class
)
(
write-pax-extended-attributes-entry
40ants-doc/locatives:generic-function
)
(
entry-pax-extended-attributes-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@pax-global-attributes-entry
(
:title
"Pax Global Attributes Entry"
:export
nil
)
(
pax-global-attributes-entry
40ants-doc/locatives:class
)
(
write-pax-global-attributes-entry
40ants-doc/locatives:generic-function
)
(
entry-pax-global-attributes-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@gnu-long-link-name-entry
(
:title
"Gnu Long Link Name Entry"
:export
nil
)
(
gnu-long-link-name-entry
40ants-doc/locatives:class
)
(
write-gnu-long-link-name-entry
40ants-doc/locatives:generic-function
)
(
entry-gnu-long-link-name-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@gnu-long-name-entry
(
:title
"Gnu Long Name Entry"
:export
nil
)
(
gnu-long-name-entry
40ants-doc/locatives:class
)
(
write-gnu-long-name-entry
40ants-doc/locatives:generic-function
)
(
entry-gnu-long-name-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@gnu-directory-dump-entry
(
:title
"Gnu Directory Dump Entry"
:export
nil
)
(
gnu-directory-dump-entry
40ants-doc/locatives:class
)
(
entry-gnu-directory-dump-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@gnu-sparse-file-entry
(
:title
"Gnu-Sparse-File Entry"
:export
nil
)
(
gnu-sparse-file-entry
40ants-doc/locatives:class
)
(
entry-gnu-sparse-file-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@gnu-volume-header-name-entry
(
:title
"Gnu Volume Header Name Entry"
:export
nil
)
(
gnu-volume-header-name-entry
40ants-doc/locatives:class
)
(
entry-gnu-volume-header-name-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@unknown-entry
(
:title
"Unknown Entry"
:export
nil
)
(
unknown-entry
40ants-doc/locatives:class
)
(
entry-unknown-p
40ants-doc/locatives:generic-function
))
(
40ants-doc:defsection
@conditions
(
:title
"Conditions"
:export
nil
)
(
tar-file-error
condition
)
(
invalid-checksum-error
condition
)
(
malformed-pax-attribute-entry
condition
))
src/entry.lisp
View file @
ff9442a2
...
...
@@ -15,7 +15,9 @@
"The FILE-POSITION of the start of the entry."
)
(
header
:initarg
:header
:reader
header
)))
:reader
header
))
(
:documentation
"Base class for all entries in a tar file."
))
(
defclass
has-data-mixin
()
())
...
...
@@ -28,17 +30,35 @@
(
defmethod
write-file-entry
(
tar-file
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.
(
let
((
computed-size
(
etypecase
data
(
string
(
setf
data
(
string-to-bytevec
data
:utf-8
))
(
push
data
args
)
(
push
:data
args
)
(
length
data
))
(
vector
(
length
data
))
(
pathname
(
with-open-file
(
s
data
:element-type
'
(
unsigned-byte
8
))
(
file-length
s
)))
(
null
0
)
(
stream
(
file-length
data
)))))
(
when
(
not
(
null
computed-size
))
(
cond
((
null
size
)
(
setf
size
computed-size
))
((
/=
size
computed-size
)
(
error
'simple-tar-file-error
:format-control
"Computed (~A) and specified (~A) sizes mismatch"
:format-args
(
list
computed-size
size
))))))
(
when
(
null
size
)
(
etypecase
data
(
vector
(
setf
size
(
length
data
)))
(
pathname
(
with-open-file
(
s
data
:element-type
'
(
unsigned-byte
8
))
(
setf
size
(
file-length
s
))))
(
stream
(
setf
size
(
file-length
data
))))
(
push
size
args
)
(
push
:size
args
))
(
error
'simple-tar-file-error
:format-control
"Size not provided and unable to compute it."
))
(
push
size
args
)
(
push
:size
args
)
(
let
((
header
(
apply
#'
make-instance
(
header-type
tar-file
)
:name
name
...
...
@@ -47,7 +67,7 @@
+tar-regular-file+
)
(
uiop:remove-plist-key
:data
args
)))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
:stream
data
)
(
write-entry
tar-file
header
:stream
data
)
(
make-instance
'file-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
hard-link-entry
(
entry
)
...
...
@@ -62,7 +82,7 @@
:typeflag
+tar-hard-link+
args
))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
)
(
write-entry
tar-file
header
)
(
make-instance
'hard-link-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
symbolic-link-entry
(
entry
)
...
...
@@ -77,7 +97,7 @@
:typeflag
+tar-symbolic-link+
args
))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
)
(
write-entry
tar-file
header
)
(
make-instance
'symbolic-link-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
character-device-entry
(
entry
)
...
...
@@ -93,7 +113,7 @@
:typeflag
+tar-character-device+
args
))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
)
(
write-entry
tar-file
header
)
(
make-instance
'character-device-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
block-device-entry
(
entry
)
...
...
@@ -109,7 +129,7 @@
:typeflag
+tar-block-device+
args
))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
)
(
write-entry
tar-file
header
)
(
make-instance
'block-device-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
directory-entry
(
entry
)
...
...
@@ -124,7 +144,7 @@
:typeflag
+tar-directory-file+
args
))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
)
(
write-entry
tar-file
header
)
(
make-instance
'directory-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
fifo-entry
(
entry
)
...
...
@@ -139,7 +159,7 @@
:typeflag
+tar-fifo-device+
args
))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
-to-tar-file
tar-file
header
)
(
write-entry
tar-file
header
)
(
make-instance
'fifo-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defclass
pax-attributes-entry
(
entry
has-data-mixin
)
...
...
@@ -152,13 +172,25 @@
(
:documentation
"Get the NAME attribute from ENTRY."
))
(
defgeneric
(
setf
attribute
)
(
new-value
entry
name
&optional
default
))
(
defmethod
attribute
((
entry
pax-attributes-entry
)
name
&optional
default
)
(
gethash
name
(
attributes
entry
)
default
))
(
defmethod
(
setf
attribute
)
(
new-value
(
entry
pax-attributes-entry
)
name
&optional
default
)
(
setf
(
gethash
name
(
attributes
entry
)
default
)
new-value
))
(
defgeneric
attribute-names
(
entry
)
(
:documentation
"Return a list of attribute names contained within ENTRY."
))
(
defmethod
attribute-names
((
entry
pax-attributes-entry
))
(
alexandria:hash-table-values
(
attributes
entry
)))
(
defmacro
do-attributes
((
name
value
entry
&optional
result
)
&body
body
)
"Given a PAX ENTRY with attributes, execute BODY for every attribute, with
NAME bound to the attribute name and VALUE bound to the attribute value."
`
(
block
nil
(
maphash
(
lambda
(
,
name
,
value
)
,@
body
)
(
attributes
,
entry
))
,
result
))
(
defun
read-attribute-length
(
stream
)
"Pop bytes out of the buffer until a space is read, then try turning that
...
...
@@ -166,8 +198,6 @@
(
let*
((
bytes-read
0
)
(
bytes
(
loop
:for
byte
:=
(
read-byte
stream
nil
:eof
)
:when
(
eql
byte
:eof
)
:do
(
return
:eof
)
:end
...
...
@@ -220,15 +250,44 @@
(
:documentation
"Extended attributes for the subsequent record."
))
(
defmethod
write-pax-extended-attributes-entry
(
tar-file
name
&rest
args
)
;; (let ((header (apply #'make-instance (header-type tar-file)
;; :name name
;; :typeflag +tar-directory-file+
;; args))
;; (start-position (file-position (tar-file-stream tar-file))))
;; (write-entry-to-tar-file tar-file header)
;; (make-instance 'directory-entry :header header :tar-file tar-file :start-position start-position))
)
(
defmethod
user-attributes-to-alist
((
attributes
hash-table
))
(
alexandria:hash-table-alist
attributes
))
(
defmethod
user-attributes-to-alist
((
attributes
list
))
attributes
)
(
defun
attribute-pair-to-bytevec
(
pair
)
(
let*
((
pair-string
(
concatenate
'string
" "
(
car
pair
)
"="
(
cdr
pair
)
(
list
#\Linefeed
)))
(
pair-vector
(
string-to-bytevec
pair-string
:utf-8
))
(
base-length
(
length
pair-vector
)))
(
loop
:for
offset
:upfrom
0
:below
2
:for
estimated-length
:=
(
+
offset
(
ceiling
(
log
base-length
10
))
base-length
)
:for
length-vector
:=
(
string-to-bytevec
(
prin1-to-string
estimated-length
)
:utf-8
)
:do
(
format
t
"~S~%"
offset
)
:when
(
=
estimated-length
(
+
(
length
length-vector
)
base-length
))
:return
(
concatenate
'
(
vector
(
unsigned-byte
8
))
length-vector
pair-vector
))))
(
defun
attribute-alist-to-bytevec
(
alist
)
(
apply
#'
concatenate
'
(
vector
(
unsigned-byte
8
))
(
mapcar
#'
attribute-pair-to-bytevec
alist
)))
(
defmethod
write-pax-extended-attributes-entry
(
tar-file
name
&rest
args
&key
attributes
)
(
let*
((
alist
(
user-attributes-to-alist
attributes
))
(
data
(
attribute-alist-to-bytevec
alist
))
(
size
(
length
data
)))
(
let
((
header
(
apply
#'
make-instance
(
header-type
tar-file
)
:name
name
:typeflag
+posix-extended-header+
:size
size
(
alexandria:remove-from-plist
args
:attributes
)))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
tar-file
header
:stream
data
)
(
make-instance
'directory-entry
:header
header
:tar-file
tar-file
:start-position
start-position
))))
(
defmethod
entry-pax-extended-attributes-p
((
entry
pax-extended-attributes-entry
))
t
)
...
...
@@ -238,15 +297,18 @@
(
:documentation
"Extended attributes for all subsequent records."
))
(
defmethod
write-pax-global-attributes-entry
(
tar-file
name
&rest
args
)
;; (let ((header (apply #'make-instance (header-type tar-file)
;; :name name
;; :typeflag +tar-directory-file+
;; args))
;; (start-position (file-position (tar-file-stream tar-file))))
;; (write-entry-to-tar-file tar-file header)
;; (make-instance 'directory-entry :header header :tar-file tar-file :start-position start-position))
)
(
defmethod
write-pax-global-attributes-entry
(
tar-file
name
&rest
args
&key
attributes
)
(
let*
((
alist
(
user-attributes-to-alist
attributes
))
(
data
(
attribute-alist-to-bytevec
alist
))
(
size
(
length
data
)))
(
let
((
header
(
apply
#'
make-instance
(
header-type
tar-file
)
:name
name
:typeflag
+posix-global-header+
:size
size
(
alexandria:remove-from-plist
args
:attributes
)))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
tar-file
header
:stream
data
)
(
make-instance
'directory-entry
:header
header
:tar-file
tar-file
:start-position
start-position
))))
(
defmethod
entry-pax-global-attributes-p
((
entry
pax-global-attributes-entry
))
t
)
...
...
@@ -268,15 +330,24 @@
(
read-sequence
buffer
stream
)
(
setf
(
long-link-name
entry
)
(
bytevec-to-string
buffer
:utf-8
))))
(
defmethod
write-gnu-long-link-name-entry
(
tar-file
name
&rest
args
)
;; (let ((header (apply #'make-instance (header-type tar-file)
;; :name name
;; :typeflag +tar-directory-file+
;; args))
;; (start-position (file-position (tar-file-stream tar-file))))
;; (write-entry-to-tar-file tar-file header)
;; (make-instance 'directory-entry :header header :tar-file tar-file :start-position start-position))
)
(
defmethod
write-gnu-long-link-name-entry
(
tar-file
name
&rest
args
&key
data
)
(
let*
((
data
(
etypecase
data
(
string
(
string-to-bytevec
data
:utf-8
))
((
vector
(
unsigned-byte
8
))
data
)))
(
size
(
length
data
))
(
header
(
apply
#'
make-instance
(
header-type
tar-file
)
:name
name
:typeflag
+gnutar-long-link-name+
:size
size
(
alexandria:remove-from-plist
args
:data
)))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
tar-file
header
:stream
data
)
(
make-instance
'gnu-long-link-name-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defmethod
entry-gnu-long-link-name-p
((
entry
gnu-long-link-name-entry
))
t
)
...
...
@@ -292,15 +363,24 @@
(
read-sequence
buffer
stream
)
(
setf
(
long-name
entry
)
(
bytevec-to-string
buffer
:utf-8
))))
(
defmethod
write-gnu-long-name-entry
(
tar-file
name
&rest
args
)
;; (let ((header (apply #'make-instance (header-type tar-file)
;; :name name
;; :typeflag +tar-directory-file+
;; args))
;; (start-position (file-position (tar-file-stream tar-file))))
;; (write-entry-to-tar-file tar-file header)
;; (make-instance 'directory-entry :header header :tar-file tar-file :start-position start-position))
)
(
defmethod
write-gnu-long-name-entry
(
tar-file
name
&rest
args
&key
data
)
(
let*
((
data
(
etypecase
data
(
string
(
string-to-bytevec
data
:utf-8
))
((
vector
(
unsigned-byte
8
))
data
)))
(
size
(
length
data
))
(
header
(
apply
#'
make-instance
(
header-type
tar-file
)
:name
name
:typeflag
+gnutar-long-link-name+
:size
size
(
alexandria:remove-from-plist
args
:data
)))
(
start-position
(
file-position
(
tar-file-stream
tar-file
))))
(
write-entry
tar-file
header
:stream
data
)
(
make-instance
'gnu-long-name-entry
:header
header
:tar-file
tar-file
:start-position
start-position
)))
(
defmethod
entry-gnu-long-name-p
((
entry
gnu-long-name-entry
))
t
)
...
...
@@ -326,18 +406,23 @@
t
)
(
defgeneric
entry-has-data-p
(
entry
)
(
:documentation
"Returns non-NIL if ENTRY has associated data that can be read using MAKE-ENTRY-STREAM."
)
(
:method
(
entry
)
nil
)
(
:method
((
entry
has-data-mixin
))
t
))
(
defgeneric
make-entry-stream
(
entry
))
(
defgeneric
make-entry-stream
(
entry
)
(
:documentation
"Returns a new binary stream that contains ENTRY's data."
))
(
defmethod
make-entry-stream
((
entry
has-data-mixin
))
(
make-bounded-stream
(
tar-file-stream
(
entry-tar-file
entry
))
(
size
entry
)
(
+
(
start-position
entry
)
+tar-n-block-bytes+
)))
(
defmacro
make-header-forwarder
(
name
)
`
(
defmethod
,
name
((
entry
entry
))
(
,
name
(
header
entry
))))
`
(
progn
(
defmethod
,
name
((
entry
entry
))
(
,
name
(
header
entry
)))))
(
make-header-forwarder
name
)
(
make-header-forwarder
mode
)
...
...
@@ -373,27 +458,23 @@
(
print-unreadable-object
(
entry
stream
)
(
format
stream
"Entry ~A"
(
name
entry
))))
(
defmethod
entry-file-p
(
entry
)
(
or
(
eql
(
typeflag
entry
)
+tar-regular-file+
)
(
eql
(
typeflag
entry
)
+tar-regular-alternate-file+
)))
(
defmethod
entry-directory-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-directory-file+
))
(
defmethod
entry-file-p
((
entry
file-entry
))
t
)
(
defmethod
entry-
hard-link
-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-hard-link+
)
)
(
defmethod
entry-
directory
-p
(
(
entry
directory-entry
)
)
t
)
(
defmethod
entry-
symbolic
-link-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-symbolic-link+
)
)
(
defmethod
entry-
hard
-link-p
(
(
entry
hard-link-entry
)
)
t
)
(
defmethod
entry-
hard
-link-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-hard-link+
)
)
(
defmethod
entry-
symbolic
-link-p
(
(
entry
symbolic-link-entry
)
)
t
)
(
defmethod
entry-character-device-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-character-device+
)
)
(
defmethod
entry-character-device-p
(
(
entry
character-device-entry
)
)
t
)
(
defmethod
entry-block-device-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-block-device+
)
)
(
defmethod
entry-block-device-p
(
(
entry
block-device-entry
)
)
t
)
(
defmethod
entry-fifo-p
(
entry
)
(
eql
(
typeflag
entry
)
+tar-fifo-device+
)
)
(
defmethod
entry-fifo-p
(
(
entry
fifo-entry
)
)
t
)
src/generics.lisp
View file @
ff9442a2
...
...
@@ -10,26 +10,151 @@ Further operations on the tar-file are undefined.
Does NOT close the underlying STREAM that backed the TAR-FILE."
))
(
defgeneric
(
setf
name
)
(
value
entry
)
(
:documentation
"Sets the name of ENTRY to VALUE."
))
(
defgeneric
name
(
entry
)
(
:documentation
"Return the name of the ENTRY (a string)."
))
(
defgeneric
mode
(
entry
)
(
:documentation
"Return the mode of the ENTRY (an integer)."
))
(
defgeneric
uid
(
entry
)
(
:documentation
"Return the uid of the ENTRY (an integer)."
))
(
defgeneric
gid
(
entry
)
(
:documentation
"Return the gid of the ENTRY (an integer)."
))
(
defgeneric
size
(
entry
)
(
:documentation
"Return the size of the ENTRY (an integer)."
))
(
defgeneric
mtime
(
entry
)
(
:documentation
"Return the mtime of the ENTRY (an integer)."
))
(
defgeneric
linkname
(
entry
)
(
:documentation
"Return the linkname of the ENTRY (a string)."
))
(
defgeneric
uname
(
entry
)
(
:documentation
"Return the uname of the ENTRY (a string)."
))
(
defgeneric
gname
(
entry
)
(
:documentation
"Return the gname of the ENTRY (a string)."
))
(
defgeneric
devmajor
(
entry
)
(
:documentation
"Return the major device of the ENTRY (an integer)."
))
(
defgeneric
devminor
(
entry
)
(
:documentation
"Return the minor device of the ENTRY (an integer)."
))
(
defgeneric
prefix
(
entry
)
(
:documentation
"Return the prefix of the ENTRY (a string)."
))
(
defgeneric
atime
(
entry
)
(
:documentation
"Return the atime of the ENTRY (an integer)."
))
(
defgeneric
ctime
(
entry
)
(
:documentation
"Return the ctime of the ENTRY (an integer)."
))
(
defgeneric
offset
(
entry
)
(
:documentation
"Return the offset of the ENTRY (an integer)."
))
(
defgeneric
offset-sparse-0
(
entry
)
(
:documentation
"Return the offset of the first sparse block of the ENTRY (an integer)."
))
(
defgeneric
numbytes-sparse-0
(
entry
)
(
:documentation
"Return the numbytes of the first sparse block of the ENTRY (an integer)."
))
(
defgeneric
offset-sparse-1
(
entry
)
(
:documentation
"Return the offset of the second sparse block of the ENTRY (an integer)."
))
(
defgeneric
numbytes-sparse-1
(
entry
)
(
:documentation
"Return the numbytes of the second sparse block of the ENTRY (an integer)."
))
(
defgeneric
offset-sparse-2
(
entry
)
(
:documentation
"Return the offset of the third sparse block of the ENTRY (an integer)."
))
(
defgeneric
numbytes-sparse-2
(
entry
)
(
:documentation
"Return the numbytes of the third sparse block of the ENTRY (an integer)."
))
(
defgeneric
offset-sparse-3
(
entry
)
(
:documentation
"Return the offset of the fourth sparse block of the ENTRY (an integer)."
))
(
defgeneric
numbytes-sparse-3
(
entry
)
(
:documentation
"Return the numbytes of the fourth sparse block of the ENTRY (an integer)."
))