Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix symlinks #42

Closed
wants to merge 5 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 27 additions & 5 deletions Codec/Archive/Tar/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,24 +65,46 @@ checkSecurity = checkEntries checkEntrySecurity
checkEntrySecurity :: Entry -> Maybe FileNameError
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If filepaths now allow .., a comment for checkSecurity needs to be updated.

checkEntrySecurity entry = case entryContent entry of
HardLink link -> check (entryPath entry)
`mplus` check (fromLinkTarget link)
`mplus` checkLink (entryPath entry) (fromLinkTarget link)
SymbolicLink link -> check (entryPath entry)
`mplus` check (fromLinkTarget link)
`mplus` checkLink (entryPath entry) (fromLinkTarget link)
_ -> check (entryPath entry)

where

checkCommon name =
FilePath.Native.isAbsolute name || not (FilePath.Native.isValid name)

check name
| FilePath.Native.isAbsolute name
| checkCommon name
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Previously when not (FilePath.Native.isValid name) we returned InvalidFileName, but now it is AbsoluteFileName. Why?

= Just $ AbsoluteFileName name

| not (FilePath.Native.isValid name)
| any (=="..") (FilePath.Native.splitDirectories name)
= Just $ InvalidFileName name

| any (=="..") (FilePath.Native.splitDirectories name)
| otherwise = Nothing

-- checkLink introduced to handle https://github.com/haskell/tar/issues/32
checkLink name link
| checkCommon name
= Just $ AbsoluteFileName name

| linkDepth link name > 0
= Just $ InvalidFileName name

| otherwise = Nothing

linkDepth :: FilePath -- ^ Name of link
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's somewhat confusing what the arguments exactly are.

First argument is:

  • the path of the symlink file relative to the tar root

Second argument is:

  • the link target, which must always be a relative path

-> FilePath -- ^ Contents of link
-> Int
linkDepth link name =
let allPaths = FilePath.Native.splitDirectories link ++ FilePath.Native.splitDirectories name
in getDepth allPaths

where getDepth [] = 0
getDepth ("..":fps) = 1 + getDepth fps
Copy link
Member

@hasufell hasufell Apr 8, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There's a bug here I believe. link itself (which is the filepath of the symlink) can already contain ... Although this is uncommon and most tools avoid doing this, our implementation does not. Note that the existence of a .. doesn't necessarily mean it's a tarbomb.

Try something like:

htar -c 'doc/../..' > /tmp/foo.tar

Afais getDepth will report a problem here and cause failure, although the symlink target itself might not be to blame. This is likely a tarbomb, but for that we have https://hackage.haskell.org/package/tar-0.5.1.1/docs/Codec-Archive-Tar-Check.html#v:checkTarbomb

getDepth (_:fps) = getDepth fps - 1
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I feel uneasy merging such changes without any regression tests. Could we please add some?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What happens if one of the elements is "."? It should not affect the depth, right? Imagine a symbolic link of form ./.././.. or similar.

@hasufell is my understanding correct here?

Copy link
Member

@hasufell hasufell Apr 7, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, I think we need to normalise first. I followed the codepath and I don't see that normalisation happens anywhere else. The link target is potentially read directly from the tar archive data and can contain anything.


-- | Errors arising from tar file names being in some way invalid or dangerous
data FileNameError
= InvalidFileName FilePath
Expand Down
2 changes: 2 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
packages: ./
, htar
2 changes: 1 addition & 1 deletion htar/htar.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ executable htar
directory >= 1.0,
filepath >= 1.0,
bytestring >= 0.9,
tar == 0.4.* && >= 0.4.2,
tar >= 0.4.2 && < 0.7,
zlib >= 0.4 && < 0.7,
bzlib >= 0.4 && < 0.7

Expand Down
6 changes: 3 additions & 3 deletions tar.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ library
build-depends: base == 4.*,
filepath < 1.5,
array < 0.6,
containers >= 0.2 && < 0.6,
containers >= 0.2 && < 0.7,
deepseq >= 1.1 && < 1.5

if flag(old-time)
Expand Down Expand Up @@ -91,8 +91,8 @@ test-suite properties
deepseq,
bytestring-handle,
QuickCheck == 2.*,
tasty >= 0.10 && <0.12,
tasty-quickcheck == 0.8.*
tasty >= 0.10 && <1.2,
tasty-quickcheck >= 0.8 && <0.11

if flag(old-time)
build-depends: directory < 1.2, old-time
Expand Down