-
Notifications
You must be signed in to change notification settings - Fork 37
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
Fix symlinks #42
Changes from all commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -65,24 +65,46 @@ checkSecurity = checkEntries checkEntrySecurity | |
checkEntrySecurity :: Entry -> Maybe FileNameError | ||
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 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Previously when |
||
= 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 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. It's somewhat confusing what the arguments exactly are. First argument is:
Second argument is:
|
||
-> 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 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. There's a bug here I believe. Try something like:
Afais |
||
getDepth (_:fps) = getDepth fps - 1 | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe 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? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. What happens if one of the elements is @hasufell is my understanding correct here? There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Yeah, I think we need to |
||
|
||
-- | Errors arising from tar file names being in some way invalid or dangerous | ||
data FileNameError | ||
= InvalidFileName FilePath | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,2 @@ | ||
packages: ./ | ||
, htar |
There was a problem hiding this comment.
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 forcheckSecurity
needs to be updated.