security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-04-13 22:21:09 +02:00
Code Activity

gpgscm: Improve path handling.

Browse Source 
* tests/gpgscm/ffi.c (ffi_init): New Scheme variable '*win32*'.
* tests/gpgscm/tests.scm (canonical-path): Correctly handle paths with
drive letter on Windows.  Use 'path-join'.
(path-expand): Use 'path-join'.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2016-10-07 12:53:25 +02:00
parent 5afbfdfd59
commit dff2660598
2 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
tests/gpgscm/ffi.c
View File

@ -1276,6 +1276,15 @@ ffi_init (scheme *sc, const char *argv0, const char *scriptname,
ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ':')); ffi_define (sc, "*pathsep*", sc->vptr->mk_character (sc, ':'));
#endif #endif
ffi_define (sc, "*win32*",
#if _WIN32
sc->T
#else
sc->F
#endif
);
ffi_define (sc, "*stdin*", ffi_define (sc, "*stdin*",
sc->vptr->mk_port_from_file (sc, stdin, port_input)); sc->vptr->mk_port_from_file (sc, stdin, port_input));
ffi_define (sc, "*stdout*", ffi_define (sc, "*stdout*",

12
tests/gpgscm/tests.scm
View File

@ -181,9 +181,15 @@
(assert (string=? (path-join "" "bar" "baz") "bar/baz")) (assert (string=? (path-join "" "bar" "baz") "bar/baz"))
(define (canonical-path path) (define (canonical-path path)
(if (char=? #\/ (string-ref path 0)) (if (or (char=? #\/ (string-ref path 0))
(and *win32* (char=? #\\ (string-ref path 0)))
(and *win32*
(char-alphabetic? (string-ref path 0))
(char=? #\: (string-ref path 1))
(or (char=? #\/ (string-ref path 2))
(char=? #\\ (string-ref path 2)))))
path path
(string-append (getcwd) "/" path))) (path-join (getcwd) path)))
(define (in-srcdir . names) (define (in-srcdir . names)
(canonical-path (apply path-join (cons (getenv "srcdir") names)))) (canonical-path (apply path-join (cons (getenv "srcdir") names))))
@ -194,7 +200,7 @@
(let loop ((path paths)) (let loop ((path paths))
(if (null? path) (if (null? path)
(throw "Could not find" name "in" paths) (throw "Could not find" name "in" paths)
(let* ((qualified-name (string-append (car path) "/" name)) (let* ((qualified-name (path-join (car path) name))
(file-exists (call-with-input-file qualified-name (file-exists (call-with-input-file qualified-name
(lambda (x) #t)))) (lambda (x) #t))))
(if file-exists (if file-exists