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
f69b6008
Commit
f69b6008
authored
Sep 25, 2021
by
Eric Timmons
Browse files
Fix bug using FILE-POSITION to jump across BLOCKED-STREAM blocks
parent
cba01ce0
Changes
3
Show whitespace changes
Inline
Side-by-side
CHANGELOG.md
View file @
f69b6008
...
...
@@ -2,6 +2,8 @@
+
Fix bug where strings read from headers were not bounded to the length of the
field.
+
Fix bug when using FILE-POSITION to jump across block boundaries on
BLOCKED-STREAMs.
## v0.1.1 - September 23, 2021
...
...
src/blocked-stream.lisp
View file @
f69b6008
...
...
@@ -43,7 +43,7 @@ START-FILE-POSITION.")
:accessor
buffer-valid-p
:initform
nil
:documentation
"T iff the BUFFER
is valid
."
)
"T iff the BUFFER
has been read at the current OFFSET
."
)
(
buffer
:accessor
buffer
:documentation
...
...
@@ -93,11 +93,6 @@ of the wrapped stream when instantiated."))
;; Record the START-FILE-POSITION
(
start-file-position
blocked-stream
)
(
ignore-errors
(
file-position
stream
)))))
(
defmethod
initialize-instance
:after
((
blocked-stream
blocked-input-stream
)
&key
stream
)
(
setf
(
stream-offset
blocked-stream
)
(
-
(
block-size
blocked-stream
))))
(
defgeneric
discard-buffer
(
stream
)
(
:documentation
"Must be called to clean up the current buffer. Resets internal state and
...
...
@@ -148,19 +143,24 @@ the buffer to be written."
(
defmethod
ensure-buffer-valid
((
stream
blocked-stream
))
(
cond
;; We haven't read from the current offset, so just fill it.
((
not
(
buffer-valid-p
stream
))
(
incf
(
stream-offset
stream
)
(
block-size
stream
))
(
fill-buffer
stream
))
;; We're at the end of the current buffer, discard it, reset the pointer to
;; the start, increase the offset, and fill it.
((
=
(
index
stream
)
(
block-size
stream
))
(
discard-buffer
stream
)
(
setf
(
index
stream
)
0
)
(
incf
(
stream-offset
stream
)
(
block-size
stream
))
(
fill-buffer
stream
))
;; We've moved past the edge of the buffer. Discard it,
((
>
(
index
stream
)
(
block-size
stream
))
(
discard-buffer
stream
)
(
loop
:while
(
>
(
index
stream
)
(
block-size
stream
))
:do
(
decf
(
index
stream
)
(
block-size
stream
))
(
incf
(
stream-offset
stream
)
(
block-size
stream
))
(
ensure
-buffer
-valid
stream
))))
(
incf
(
stream-offset
stream
)
(
block-size
stream
))
)
(
fill
-buffer
stream
))))
(
defmethod
trivial-gray-streams:stream-read-byte
((
stream
blocked-input-stream
))
(
ensure-buffer-valid
stream
)
...
...
@@ -229,13 +229,6 @@ the buffer to be written."
(
let*
((
start-of-chunk-position
(
*
(
block-size
stream
)
(
floor
(
/
newval
(
block-size
stream
)))))
(
new-index
(
-
newval
start-of-chunk-position
)))
(
flet
((
read-forward
()
(
loop
:while
(
/=
(
stream-offset
stream
)
start-of-chunk-position
)
:do
(
discard-buffer
stream
)
(
setf
(
index
stream
)
(
block-size
stream
))
(
ensure-buffer-valid
stream
))))
(
cond
((
and
(
=
start-of-chunk-position
(
stream-offset
stream
))
(
or
(
null
(
eof-index
stream
))
...
...
@@ -255,8 +248,9 @@ the buffer to be written."
;; determine the starting FILE-POSITION of the wrapped stream. However,
;; we want to seek forward, so we can just read blocks until we get
;; there.
(
read-forward
)
(
setf
(
index
stream
)
new-index
)
(
discard-buffer
)
(
setf
(
index
stream
)
(
+
start-of-chunk-position
new-index
))
(
ensure-buffer-valid
)
t
)
((
null
(
start-file-position
stream
))
;; We weren't able to figure out the start position of the wrapped
...
...
@@ -271,8 +265,9 @@ the buffer to be written."
(
stream-offset
stream
)
start-of-chunk-position
)
t
)
(
when
(
>
start-of-chunk-position
(
stream-offset
stream
))
(
read-forward
)
t
)))))))
(
setf
(
index
stream
)
(
+
start-of-chunk-position
new-index
))
(
ensure-buffer-valid
)
t
))))))
(
defmethod
close
((
stream
blocked-stream
)
&key
abort
)
(
unless
abort
...
...
test/blocked-stream.lisp
View file @
f69b6008
...
...
@@ -78,3 +78,66 @@
(
para:is
eql
:eof
(
read-byte
s
nil
:eof
))
(
file-position
s
0
)
(
para:is
=
(
char-code
#\a
)
(
read-byte
s
))))))
(
para:define-test
jumping-across-blocks
(
uiop:with-temporary-file
(
:stream
raw-stream
:pathname
pn
:element-type
'
(
unsigned-byte
8
))
(
write-sequence
(
make-array
1024
:element-type
'
(
unsigned-byte
8
)
:initial-element
0
)
raw-stream
)
(
write-sequence
(
make-array
1024
:element-type
'
(
unsigned-byte
8
)
:initial-element
1
)
raw-stream
)
:close-stream
(
with-open-file
(
raw-stream
pn
:element-type
'
(
unsigned-byte
8
))
(
with-open-stream
(
s
(
make-instance
'tar-file::blocked-input-stream
:stream
raw-stream
:block-size
1024
))
(
let
((
seq
(
make-array
512
:element-type
'
(
unsigned-byte
8
)
:initial-element
0
)))
(
read-sequence
seq
s
)
(
para:true
(
every
#'
zerop
seq
))
(
read-sequence
seq
s
)
(
para:true
(
every
#'
zerop
seq
))
(
read-sequence
seq
s
)
(
para:true
(
every
(
lambda
(
x
)
(
=
x
1
))
seq
))
(
file-position
s
512
)
(
read-sequence
seq
s
)
(
para:true
(
every
#'
zerop
seq
))
(
read-sequence
seq
s
)
(
para:true
(
every
(
lambda
(
x
)
(
=
x
1
))
seq
)))))))
(
para:define-test
bounded-stream-jumping-across-blocks
(
uiop:with-temporary-file
(
:stream
raw-stream
:pathname
pn
:element-type
'
(
unsigned-byte
8
))
(
write-sequence
(
make-array
1024
:element-type
'
(
unsigned-byte
8
)
:initial-element
0
)
raw-stream
)
(
write-sequence
(
make-array
1024
:element-type
'
(
unsigned-byte
8
)
:initial-element
1
)
raw-stream
)
:close-stream
(
with-open-file
(
raw-stream
pn
:element-type
'
(
unsigned-byte
8
))
(
with-open-stream
(
s
(
make-instance
'tar-file::blocked-input-stream
:stream
raw-stream
:block-size
1024
))
(
let
((
seq-1
(
make-array
512
:element-type
'
(
unsigned-byte
8
)
:initial-element
0
))
(
seq-2
(
make-array
1024
:element-type
'
(
unsigned-byte
8
)
:initial-element
0
)))
(
read-sequence
seq-1
s
)
(
para:true
(
every
#'
zerop
seq-1
))
(
with-open-stream
(
bounded-stream
(
tar-file::make-bounded-stream
s
1024
))
(
read-sequence
seq-2
bounded-stream
)
(
para:true
(
every
#'
zerop
(
subseq
seq-2
0
512
)))
(
para:true
(
every
(
lambda
(
x
)
(
=
x
1
))
(
subseq
seq-2
512
))))
(
with-open-stream
(
bounded-stream
(
tar-file::make-bounded-stream
s
1024
512
))
(
read-sequence
seq-2
bounded-stream
)
(
para:true
(
every
#'
zerop
(
subseq
seq-2
0
512
)))
(
para:true
(
every
(
lambda
(
x
)
(
=
x
1
))
(
subseq
seq-2
512
))))
(
read-sequence
seq-1
s
)
(
para:true
(
every
(
lambda
(
x
)
(
=
x
1
))
seq-1
)))))))
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