suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

git-checkout: document and test #:strict-links?

Browse Source
This commit is contained in:
Matthew Flatt 2015-10-02 09:26:52 -06:00
parent 37814da758
commit 23e2b806a2
2 changed files with 75 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
net-doc/net/scribblings/git-checkout.scrbl
View File

@ -35,7 +35,8 @@ for information on command-line arguments and flags.
[#:port port (or/c #f (integer-in 1 65535)) (case transport
[(git) 9418]
[(http) 80]
[(https) 443])])
[(https) 443])]
[#:strict-links? strict-links? any/c #f])
string?]{
Contacts the server at @racket[hostname] and @racket[port]
@ -91,5 +92,10 @@ temporary clone of the repository, and the files are preserved unless
the shape that is recognized by other tools, such as @exec{git}, and
so a preserved temporary directory is useful mainly for debugging.
If @racket[strict-links?] is true, then the checkout fails with an
error if it would produce a symbolic link that refers to an absolute path
or to a relative path that contains up-directory elements.
@history[#:added "6.1.1.1"
#:changed "6.3" @elem{Added the @racket[initial-error] argument.}]}
#:changed "6.3" @elem{Added the @racket[initial-error] argument.}
#:changed "6.2.900.17" @elem{Added the @racket[strict-links?] argument.}]}

101
net-test/tests/net/git-checkout.rkt
View File

@ -60,47 +60,72 @@
(error 'compare "no such file: ~s" a)]))
(when git
(define dir (make-temporary-file "~a-git-test" 'directory))
(define http-custodian (make-custodian))
(dynamic-wind
void
(lambda ()
(parameterize ([current-custodian http-custodian])
(thread
(lambda ()
(serve/servlet
void
#:command-line? #t
#:extra-files-paths (list dir)
#:servlet-regexp #rx"$." ; no servlets
#:port 8950))))
(for ([link-mode '(rel up abs)])
(define dir (make-temporary-file "~a-git-test" 'directory))
(define http-custodian (make-custodian))
(dynamic-wind
void
(lambda ()
(parameterize ([current-custodian http-custodian])
(thread
(lambda ()
(serve/servlet
void
#:command-line? #t
#:extra-files-paths (list dir)
#:servlet-regexp #rx"$." ; no servlets
#:port 8950))))
(parameterize ([current-directory dir])
(make-directory "repo")
(parameterize ([current-directory "repo"])
(make-file "x" #"hello")
(make-file "y" #"goodbye")
(unless (eq? (system-type) 'windows)
(file-or-directory-permissions "y" #o755))
(make-file "z" #"whatever")
(unless (eq? (system-type) 'windows)
(file-or-directory-permissions "z" #o644))
(unless (eq? (system-type) 'windows)
(make-file-or-directory-link "x" "also-x"))
(git "init")
(git "add" ".")
(git "commit" "-m" "initial commit")
(git "update-server-info"))
(parameterize ([current-directory dir])
(make-directory "repo")
(parameterize ([current-directory "repo"])
(make-file "x" #"hello")
(make-file "y" #"goodbye")
(unless (eq? (system-type) 'windows)
(file-or-directory-permissions "y" #o755))
(make-file "z" #"whatever")
(unless (eq? (system-type) 'windows)
(file-or-directory-permissions "z" #o644))
(make-directory "nested")
(make-file "nested/x" #"stuff")
(unless (eq? (system-type) 'windows)
(case link-mode
[(abs)
(make-file-or-directory-link "/tmp/x" "abs-x")]
[(up)
(make-file-or-directory-link "../x" "abs-x")]
[else
(make-file-or-directory-link "x" "also-x")]))
(git "init")
(git "add" ".")
(git "commit" "-m" "initial commit")
(git "update-server-info"))
(git-checkout "localhost" #:port 8950 #:transport 'http
"repo/.git"
#:dest-dir "also-repo")
(git-checkout "localhost" #:port 8950 #:transport 'http
"repo/.git"
#:dest-dir "also-repo")
(compare "repo" "also-repo")
(compare "repo" "also-repo")
(with-handlers ([exn:fail?
(lambda (exn)
(case link-mode
[(abs up)
(if (regexp-match? #rx"won't extract" (exn-message exn))
(printf "correct failure\n")
(raise exn))]
[else (raise exn)]))])
(git-checkout "localhost" #:port 8950 #:transport 'http
"repo/.git"
#:dest-dir "safe-repo"
#:strict-links? #t)
(case link-mode
[(abs up) (unless (eq? 'windows (system-type))
(error "should not have worked"))])
(compare "repo" "safe-repo"))
(void)))
(lambda ()
(custodian-shutdown-all http-custodian)
(delete-directory/files dir))))
(void)))
(lambda ()
(custodian-shutdown-all http-custodian)
(delete-directory/files dir)))))