add file-or-directory-type

Since file links and directory links on Windows are disjoint, and the
difference is relevant for operations such as deleting a file,
`link-exists?` is not enough information. Add `file-or-directory-type`
to provide more information and also avoid separate calls to
`file-exists?`, `directory-exists?`, etc.

The `delete-directory/files` function now uses `file-or-directory-type`
so that it will work right with Windows directory links.

Relevant to #3288
This commit is contained in:
Matthew Flatt 2020-07-15 17:58:31 -06:00
parent 1a7c898ea2
commit d2f8c83368
16 changed files with 243 additions and 30 deletions

View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "7.8.0.4") (define version "7.8.0.5")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

View File

@ -286,6 +286,21 @@ symbolic links and junctions.
@history[#:changed "6.0.1.12" @elem{Added support for links on Windows.}]} @history[#:changed "6.0.1.12" @elem{Added support for links on Windows.}]}
@defproc[(file-or-directory-type [path path-string?] [must-exist? any/c #f])
(or/c 'file 'directory 'link 'directory-link #f)]{
Reports whether @racket[path] refers to a file, directory, link, or
directory link (in the case of Windows; see also
@racket[make-file-or-directory-link]), assuming that @racket[path] can
be accessed.
If @racket[path] cannot be accessed, the result is @racket[#f] if
@racket[must-exist?] is @racket[#f], otherwise the
@exnraise[exn:fail:filesystem].
@history[#:added "7.8.0.5"]}
@defproc[(delete-file [path path-string?]) void?]{ @defproc[(delete-file [path path-string?]) void?]{
Deletes the file with path @racket[path] if it exists, otherwise the Deletes the file with path @racket[path] if it exists, otherwise the
@ -473,14 +488,14 @@ successfully,the @exnraise[exn:fail:filesystem].
On Windows XP and earlier, the @exnraise[exn:fail:unsupported]. On On Windows XP and earlier, the @exnraise[exn:fail:unsupported]. On
later versions of Windows, the creation of links tends to be later versions of Windows, the creation of links tends to be
disallowed by security policies. Windows distinguishes between file disallowed by security policies. Windows distinguishes between file
and directory links, and a directory link is created if @racket[to] and directory links, and a directory link is created only if
parses syntactically as a directory. Furthermore, a relative-path link @racket[to] parses syntactically as a directory (see
is parsed specially by the operating system; see @racket[path->directory-path]). Furthermore, a relative-path link is
@secref["windowspaths"] for more information. When parsed specially by the operating system; see @secref["windowspaths"]
@racket[make-file-or-directory-link] succeeds, it creates a symbolic for more information. When @racket[make-file-or-directory-link]
link as opposed to a junction or hard link. Beware that directory succeeds, it creates a symbolic link as opposed to a junction or hard
links must be deleted using @racket[delete-directory] instead of link. Beware that directory links must be deleted using
@racket[delete-file]. @racket[delete-directory] instead of @racket[delete-file].
@history[#:changed "6.0.1.12" @elem{Added support for links on Windows.}]} @history[#:changed "6.0.1.12" @elem{Added support for links on Windows.}]}

View File

@ -243,7 +243,7 @@ with a different parent than @litchar{d}, the path nevertheless refers
to @litchar{f} in the same directory as @litchar{d}. A relative-path to @litchar{f} in the same directory as @litchar{d}. A relative-path
link is parsed as if prefixed with @litchar{\\?\REL} paths, except link is parsed as if prefixed with @litchar{\\?\REL} paths, except
that @litchar{..} and @litchar{.} elements are allowed throughout the that @litchar{..} and @litchar{.} elements are allowed throughout the
path, and any number of redundant @litchar{/} separators are allowed. path, and any number of redundant @litchar{\} separators are allowed.
Windows paths are @techlink{cleanse}d as follows: In paths that start Windows paths are @techlink{cleanse}d as follows: In paths that start
@litchar{\\?\}, redundant @litchar{\}s are removed, an extra @litchar{\\?\}, redundant @litchar{\}s are removed, an extra

View File

@ -1789,6 +1789,7 @@
(test #t file-exists? "tmp1") (test #t file-exists? "tmp1")
(test #f directory-exists? "tmp1") (test #f directory-exists? "tmp1")
(test #f link-exists? "tmp1") (test #f link-exists? "tmp1")
(test 'file file-or-directory-type "tmp1")
(err/rt-test (open-output-file "tmp1") (fs-reject? 'open-output-file)) (err/rt-test (open-output-file "tmp1") (fs-reject? 'open-output-file))
(err/rt-test (delete-file "tmp1") (fs-reject? 'delete-file)) (err/rt-test (delete-file "tmp1") (fs-reject? 'delete-file))
@ -1831,6 +1832,7 @@
(err/rt-test (file-exists? "tmp1") (fs-reject? 'file-exists?)) (err/rt-test (file-exists? "tmp1") (fs-reject? 'file-exists?))
(err/rt-test (directory-exists? "tmp1") (fs-reject? 'directory-exists?)) (err/rt-test (directory-exists? "tmp1") (fs-reject? 'directory-exists?))
(err/rt-test (link-exists? "tmp1") (fs-reject? 'link-exists?)) (err/rt-test (link-exists? "tmp1") (fs-reject? 'link-exists?))
(err/rt-test (file-or-directory-type "tmp1") (fs-reject? 'file-or-directory-type))
(err/rt-test (path->complete-path "tmp1") (fs-reject? 'path->complete-path)) (err/rt-test (path->complete-path "tmp1") (fs-reject? 'path->complete-path))
(err/rt-test (filesystem-root-list) (fs-reject? 'filesystem-root-list)) (err/rt-test (filesystem-root-list) (fs-reject? 'filesystem-root-list))
(err/rt-test (find-system-path 'temp-dir) (fs-reject? 'find-system-path))) (err/rt-test (find-system-path 'temp-dir) (fs-reject? 'find-system-path)))
@ -2219,9 +2221,12 @@
(define z (build-path z-dir "z")) (define z (build-path z-dir "z"))
(parameterize ([current-directory (pick-directory made)]) (parameterize ([current-directory (pick-directory made)])
(test #f directory-exists? z-dir) (test #f directory-exists? z-dir)
(test #f file-or-directory-type z-dir)
(err/rt-test (file-or-directory-type z-dir #t) exn:fail:filesystem?)
(test #f file-exists? z) (test #f file-exists? z)
(make-parent-directory* z) (make-parent-directory* z)
(test #t directory-exists? z-dir) (test #t directory-exists? z-dir)
(test 'directory file-or-directory-type z-dir)
(make-parent-directory* z) (make-parent-directory* z)
(delete-directory/files z-dir) (delete-directory/files z-dir)
(test #f directory-exists? z-dir) (test #f directory-exists? z-dir)
@ -2317,12 +2322,33 @@
(let ([tf (make-temporary-file)]) (let ([tf (make-temporary-file)])
(test tf resolve-path (path->string tf)) (test tf resolve-path (path->string tf))
(unless (eq? 'windows (system-type))
(delete-file tf)
(make-file-or-directory-link "other.txt" tf)
(err/rt-test (make-file-or-directory-link "other.txt" tf) exn:fail:filesystem? (regexp-quote tf))
(test (string->path "other.txt") resolve-path tf))
(delete-file tf) (delete-file tf)
(define link-created?
(with-handlers ([(lambda (exn) (and (eq? 'windows (system-type))
(exn:fail:filesystem? exn)))
(lambda (exn) #f)])
(make-file-or-directory-link "other.txt" tf)
#t))
(when link-created?
(err/rt-test (make-file-or-directory-link "other.txt" tf) exn:fail:filesystem? (regexp-quote tf))
(test (string->path "other.txt") resolve-path tf)
(test #t link-exists? tf)
(test 'link file-or-directory-type tf)
(delete-file tf)
(make-file-or-directory-link (path->directory-path "other") tf)
(test #t link-exists? tf)
(test (if (eq? (system-type) 'windows) 'directory-link 'link) file-or-directory-type tf)
(if (eq? (system-type) 'windows)
(delete-directory tf)
(delete-file tf))
(test #f link-exists? tf)
(make-file-or-directory-link (path->directory-path "other") tf)
(test #t link-exists? tf)
(delete-directory/files tf)
(test #f link-exists? tf))
(case (system-path-convention-type) (case (system-path-convention-type)
[(unix) [(unix)
(test (string->path "/testing-root/testing-dir/testing-file") (test (string->path "/testing-root/testing-dir/testing-file")
@ -2343,6 +2369,18 @@
;; Make sure directoryness is preserved ;; Make sure directoryness is preserved
(test (current-directory) resolve-path (current-directory))) (test (current-directory) resolve-path (current-directory)))
(when (eq? (system-type) 'windows)
;; special filenames exist everywhere
(test #t file-exists? "aux")
(test #t file-exists? "aux.anything")
(test #t file-exists? "c:/aux")
(test #t file-exists? "c:/com1")
(test #t file-exists? "a:/x/lpt6")
(test 'file file-or-directory-type "a:/x/lpt6")
;; \\?\ paths don't refer to special filenames
(test #f file-exists? "\\\\?\\C:\\aux")
(test #f file-or-directory-type "\\\\?\\C:\\aux"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure `write-byte` and `write-char` don't try to test ;; Make sure `write-byte` and `write-char` don't try to test
;; a non-supplied argument: ;; a non-supplied argument:

View File

@ -51,16 +51,18 @@
(unless (path-string? path) (unless (path-string? path)
(raise-argument-error 'delete-directory/files "path-string?" path)) (raise-argument-error 'delete-directory/files "path-string?" path))
(let loop ([path path]) (let loop ([path path])
(cond (case (file-or-directory-type path)
[(or (link-exists? path) (file-exists? path)) [(file link)
(delete-file* path)] (delete-file* path)]
[(directory-exists? path) [(directory)
(for-each (lambda (e) (loop (build-path path e))) (for-each (lambda (e) (loop (build-path path e)))
(directory-list path)) (directory-list path))
(delete-directory path)] (delete-directory path)]
[else [(directory-link)
(when must-exist? (delete-directory path)]
(raise-not-a-file-or-directory 'delete-directory/files path))]))) [else
(when must-exist?
(raise-not-a-file-or-directory 'delete-directory/files path))])))
(define (delete-file* path) (define (delete-file* path)
(cond (cond

View File

@ -376,6 +376,7 @@
[file-or-directory-identity (known-procedure/no-prompt 6)] [file-or-directory-identity (known-procedure/no-prompt 6)]
[file-or-directory-modify-seconds (known-procedure/no-prompt 14)] [file-or-directory-modify-seconds (known-procedure/no-prompt 14)]
[file-or-directory-permissions (known-procedure/no-prompt 6)] [file-or-directory-permissions (known-procedure/no-prompt 6)]
[file-or-directory-type (known-procedure/no-prompt 6)]
[file-position (known-procedure/no-prompt 6)] [file-position (known-procedure/no-prompt 6)]
[file-position* (known-procedure/no-prompt 2)] [file-position* (known-procedure/no-prompt 2)]
[file-size (known-procedure/no-prompt 2)] [file-size (known-procedure/no-prompt 2)]

View File

@ -4,6 +4,7 @@
"../path/path.rkt" "../path/path.rkt"
"../path/parameter.rkt" "../path/parameter.rkt"
"../path/directory-path.rkt" "../path/directory-path.rkt"
(only-in "../path/windows.rkt" special-filename?)
"../host/rktio.rkt" "../host/rktio.rkt"
"../host/thread.rkt" "../host/thread.rkt"
"../host/error.rkt" "../host/error.rkt"
@ -19,6 +20,7 @@
(provide directory-exists? (provide directory-exists?
file-exists? file-exists?
link-exists? link-exists?
file-or-directory-type
make-directory make-directory
directory-list directory-list
current-force-delete-permissions current-force-delete-permissions
@ -46,12 +48,41 @@
(define/who (file-exists? p) (define/who (file-exists? p)
(check who path-string? p) (check who path-string? p)
(rktio_file_exists rktio (->host p who '(exists)))) (define host-path (->host p who '(exists)))
(cond
[(and (eq? 'windows (system-type))
(special-filename? host-path #:immediate? #f))
#t]
[else
(rktio_file_exists rktio host-path)]))
(define/who (link-exists? p) (define/who (link-exists? p)
(check who path-string? p) (check who path-string? p)
(rktio_link_exists rktio (->host p who '(exists)))) (rktio_link_exists rktio (->host p who '(exists))))
(define/who (file-or-directory-type p [must-exist? #f])
(check who path-string? p)
(define host-path (->host p who '(exists)))
(cond
[(and (eq? 'windows (system-type))
(special-filename? host-path #:immediate? #f))
'file]
[else
(define r (rktio_file_type rktio host-path))
(cond
[(eqv? r RKTIO_FILE_TYPE_FILE) 'file]
[(eqv? r RKTIO_FILE_TYPE_DIRECTORY) 'directory]
[(eqv? r RKTIO_FILE_TYPE_LINK) 'link]
[(eqv? r RKTIO_FILE_TYPE_DIRECTORY_LINK) 'directory-link]
[else
(and must-exist?
(raise-filesystem-error who
r
(format (string-append
"access failed\n"
" path: ~a")
(host-> host-path))))])]))
(define/who (make-directory p) (define/who (make-directory p)
(check who path-string? p) (check who path-string? p)
(define host-path (->host p who '(write))) (define host-path (->host p who '(write)))

View File

@ -41,7 +41,7 @@
(define-syntax-rule (define-function/errno+step _ _ _ name . _) (define-syntax-rule (define-function/errno+step _ _ _ name . _)
(define-function () #f name)) (define-function () #f name))
(include "../../rktio/rktio.rktl") (include "../../rktio/rktio.rktl") ; 1
(define-function () #f rktio_filesize_ref) (define-function () #f rktio_filesize_ref)
(define-function () #f rktio_timestamp_ref) (define-function () #f rktio_timestamp_ref)

View File

@ -94,6 +94,7 @@ static Scheme_Object *expand_user_path(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_drive(int argc, Scheme_Object *argv[]); static Scheme_Object *current_drive(int argc, Scheme_Object *argv[]);
static Scheme_Object *file_modify_seconds(int argc, Scheme_Object *argv[]); static Scheme_Object *file_modify_seconds(int argc, Scheme_Object *argv[]);
static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[]); static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[]);
static Scheme_Object *file_or_dir_type(int argc, Scheme_Object *argv[]);
static Scheme_Object *file_identity(int argc, Scheme_Object *argv[]); static Scheme_Object *file_identity(int argc, Scheme_Object *argv[]);
static Scheme_Object *file_size(int argc, Scheme_Object *argv[]); static Scheme_Object *file_size(int argc, Scheme_Object *argv[]);
static Scheme_Object *find_system_path(int argc, Scheme_Object **argv); static Scheme_Object *find_system_path(int argc, Scheme_Object **argv);
@ -134,6 +135,8 @@ SHARED_OK static Scheme_Object *addon_dir;
READ_ONLY static Scheme_Object *windows_symbol, *unix_symbol; READ_ONLY static Scheme_Object *windows_symbol, *unix_symbol;
READ_ONLY static Scheme_Object *file_symbol, *directory_symbol, *link_symbol, *directory_link_symbol;
void scheme_init_file(Scheme_Startup_Env *env) void scheme_init_file(Scheme_Startup_Env *env)
{ {
Scheme_Object *p; Scheme_Object *p;
@ -166,6 +169,11 @@ void scheme_init_file(Scheme_Startup_Env *env)
REGISTER_SO(windows_symbol); REGISTER_SO(windows_symbol);
REGISTER_SO(unix_symbol); REGISTER_SO(unix_symbol);
REGISTER_SO(file_symbol);
REGISTER_SO(directory_symbol);
REGISTER_SO(link_symbol);
REGISTER_SO(directory_link_symbol);
up_symbol = scheme_intern_symbol("up"); up_symbol = scheme_intern_symbol("up");
relative_symbol = scheme_intern_symbol("relative"); relative_symbol = scheme_intern_symbol("relative");
same_symbol = scheme_intern_symbol("same"); same_symbol = scheme_intern_symbol("same");
@ -195,6 +203,11 @@ void scheme_init_file(Scheme_Startup_Env *env)
windows_symbol = scheme_intern_symbol("windows"); windows_symbol = scheme_intern_symbol("windows");
unix_symbol = scheme_intern_symbol("unix"); unix_symbol = scheme_intern_symbol("unix");
file_symbol = scheme_intern_symbol("file");
directory_symbol = scheme_intern_symbol("directory");
link_symbol = scheme_intern_symbol("link");
directory_link_symbol = scheme_intern_symbol("directory-link");
p = scheme_make_immed_prim(path_p, "path?", 1, 1); p = scheme_make_immed_prim(path_p, "path?", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_OMITABLE
@ -388,6 +401,11 @@ void scheme_init_file(Scheme_Startup_Env *env)
"file-or-directory-permissions", "file-or-directory-permissions",
1, 2), 1, 2),
env); env);
scheme_addto_prim_instance("file-or-directory-type",
scheme_make_prim_w_arity(file_or_dir_type,
"file-or-directory-type",
1, 2),
env);
scheme_addto_prim_instance("file-or-directory-identity", scheme_addto_prim_instance("file-or-directory-identity",
scheme_make_prim_w_arity(file_identity, scheme_make_prim_w_arity(file_identity,
"file-or-directory-identity", "file-or-directory-identity",
@ -4797,6 +4815,44 @@ static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[])
return NULL; return NULL;
} }
static Scheme_Object *file_or_dir_type(int argc, Scheme_Object *argv[])
{
char *filename;
int type;
if (!SCHEME_PATH_STRINGP(argv[0]))
scheme_wrong_contract("file-or-directory-type", "path-string?", 0, argc, argv);
filename = scheme_expand_string_filename(argv[0],
"file-or-directory-type",
NULL,
SCHEME_GUARD_FILE_EXISTS);
if (scheme_is_special_filename(filename, 0))
type = RKTIO_FILE_TYPE_FILE;
else
type = rktio_file_type(scheme_rktio, filename);
if (type == RKTIO_FILE_TYPE_FILE)
return file_symbol;
else if (type == RKTIO_FILE_TYPE_DIRECTORY)
return directory_symbol;
else if (type == RKTIO_FILE_TYPE_LINK)
return link_symbol;
else if (type == RKTIO_FILE_TYPE_DIRECTORY_LINK)
return directory_link_symbol;
else {
MZ_ASSERT(type == RKTIO_FILE_TYPE_ERROR);
if ((argc > 1) && SCHEME_TRUEP(argv[1]))
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"file-or-directory-type: access failed\n"
" path: %q\n"
" system error: %R",
filename_for_error(argv[0]));
return scheme_false;
}
}
static Scheme_Object *file_identity(int argc, Scheme_Object *argv[]) static Scheme_Object *file_identity(int argc, Scheme_Object *argv[])
{ {
char *filename; char *filename;

View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1471 #define EXPECTED_PRIM_COUNT 1472
#ifdef MZSCHEME_SOMETHING_OMITTED #ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP # undef USE_COMPILED_STARTUP

View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 8 #define MZSCHEME_VERSION_Y 8
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_W 5
/* A level of indirection makes `#` work as needed: */ /* A level of indirection makes `#` work as needed: */
#define AS_a_STR_HELPER(x) #x #define AS_a_STR_HELPER(x) #x

View File

@ -130,6 +130,7 @@ rktio_file_exists
rktio_directory_exists rktio_directory_exists
rktio_link_exists rktio_link_exists
rktio_is_regular_file rktio_is_regular_file
rktio_file_type
rktio_delete_file rktio_delete_file
rktio_rename_file rktio_rename_file
rktio_get_current_directory rktio_get_current_directory

View File

@ -806,6 +806,21 @@ RKTIO_EXTERN rktio_bool_t rktio_file_exists(rktio_t *rktio, rktio_const_string_t
RKTIO_EXTERN rktio_bool_t rktio_directory_exists(rktio_t *rktio, rktio_const_string_t dirname); RKTIO_EXTERN rktio_bool_t rktio_directory_exists(rktio_t *rktio, rktio_const_string_t dirname);
RKTIO_EXTERN rktio_bool_t rktio_link_exists(rktio_t *rktio, rktio_const_string_t filename); RKTIO_EXTERN rktio_bool_t rktio_link_exists(rktio_t *rktio, rktio_const_string_t filename);
RKTIO_EXTERN rktio_bool_t rktio_is_regular_file(rktio_t *rktio, rktio_const_string_t filename); RKTIO_EXTERN rktio_bool_t rktio_is_regular_file(rktio_t *rktio, rktio_const_string_t filename);
/* On Windows, check for special filenames (like "aux") before calling
the `rktio_file_exists` or `rktio_is_regular_file`. */
#define RKTIO_FILE_TYPE_FILE 1
#define RKTIO_FILE_TYPE_DIRECTORY 2
#define RKTIO_FILE_TYPE_LINK 3
#define RKTIO_FILE_TYPE_DIRECTORY_LINK 4
#define RKTIO_FILE_TYPE_ERROR (-1)
RKTIO_EXTERN_ERR(RKTIO_FILE_TYPE_ERROR)
int rktio_file_type(rktio_t *rktio, rktio_const_string_t filename);
/* Result is `RKTIO_FILE_TYPE_ERROR` for error, otherwise one of
the `RKTIO_FILE_TYPE_...` values. On Windows, check for special
filenames (like "aux") before calling this function. */
RKTIO_EXTERN rktio_ok_t rktio_delete_file(rktio_t *rktio, rktio_const_string_t fn, rktio_bool_t enable_write_on_fail); RKTIO_EXTERN rktio_ok_t rktio_delete_file(rktio_t *rktio, rktio_const_string_t fn, rktio_bool_t enable_write_on_fail);

View File

@ -130,6 +130,7 @@ Sforeign_symbol("rktio_file_exists", (void *)rktio_file_exists);
Sforeign_symbol("rktio_directory_exists", (void *)rktio_directory_exists); Sforeign_symbol("rktio_directory_exists", (void *)rktio_directory_exists);
Sforeign_symbol("rktio_link_exists", (void *)rktio_link_exists); Sforeign_symbol("rktio_link_exists", (void *)rktio_link_exists);
Sforeign_symbol("rktio_is_regular_file", (void *)rktio_is_regular_file); Sforeign_symbol("rktio_is_regular_file", (void *)rktio_is_regular_file);
Sforeign_symbol("rktio_file_type", (void *)rktio_file_type);
Sforeign_symbol("rktio_delete_file", (void *)rktio_delete_file); Sforeign_symbol("rktio_delete_file", (void *)rktio_delete_file);
Sforeign_symbol("rktio_rename_file", (void *)rktio_rename_file); Sforeign_symbol("rktio_rename_file", (void *)rktio_rename_file);
Sforeign_symbol("rktio_get_current_directory", (void *)rktio_get_current_directory); Sforeign_symbol("rktio_get_current_directory", (void *)rktio_get_current_directory);

View File

@ -63,6 +63,11 @@
(define-constant RKTIO_LTPS_HANDLE_NONE 0) (define-constant RKTIO_LTPS_HANDLE_NONE 0)
(define-constant RKTIO_LTPS_HANDLE_ZERO 1) (define-constant RKTIO_LTPS_HANDLE_ZERO 1)
(define-constant RKTIO_LTPS_HANDLE_FREE 2) (define-constant RKTIO_LTPS_HANDLE_FREE 2)
(define-constant RKTIO_FILE_TYPE_FILE 1)
(define-constant RKTIO_FILE_TYPE_DIRECTORY 2)
(define-constant RKTIO_FILE_TYPE_LINK 3)
(define-constant RKTIO_FILE_TYPE_DIRECTORY_LINK 4)
(define-constant RKTIO_FILE_TYPE_ERROR -1)
(define-constant RKTIO_PERMISSION_READ 4) (define-constant RKTIO_PERMISSION_READ 4)
(define-constant RKTIO_PERMISSION_WRITE 2) (define-constant RKTIO_PERMISSION_WRITE 2)
(define-constant RKTIO_PERMISSION_EXEC 1) (define-constant RKTIO_PERMISSION_EXEC 1)
@ -988,6 +993,12 @@
rktio_bool_t rktio_bool_t
rktio_is_regular_file rktio_is_regular_file
(((ref rktio_t) rktio) (rktio_const_string_t filename))) (((ref rktio_t) rktio) (rktio_const_string_t filename)))
(define-function/errno
RKTIO_FILE_TYPE_ERROR
()
int
rktio_file_type
(((ref rktio_t) rktio) (rktio_const_string_t filename)))
(define-function/errno (define-function/errno
#f #f
() ()

View File

@ -372,7 +372,7 @@ static int UNC_stat(rktio_t *rktio, const char *dirname, int *flags, int *isdir,
wp = WIDE_PATH_temp(copy); wp = WIDE_PATH_temp(copy);
if (!wp) { if (!wp) {
/* Treat invalid path as non-existent */ /* Treat invalid path as non-existent; `WIDE_PATH_temp` set the error */
free(copy); free(copy);
return 0; return 0;
} }
@ -385,6 +385,8 @@ static int UNC_stat(rktio_t *rktio, const char *dirname, int *flags, int *isdir,
if ((GET_FF_ATTRIBS(fad) & FF_A_LINK) && !same_path) { if ((GET_FF_ATTRIBS(fad) & FF_A_LINK) && !same_path) {
if (islink) { if (islink) {
*islink = 1; *islink = 1;
if (isdir)
*isdir = (GET_FF_ATTRIBS(fad) & FF_A_DIR);
return 1; return 1;
} else { } else {
/* Resolve a link by opening the link and then getting /* Resolve a link by opening the link and then getting
@ -587,6 +589,46 @@ int rktio_link_exists(rktio_t *rktio, const char *filename)
#endif #endif
} }
int rktio_file_type(rktio_t *rktio, rktio_const_string_t filename)
/* Windows: check for special filenames before calling */
{
#ifdef RKTIO_SYSTEM_WINDOWS
{
int islink, isdir;
if (UNC_stat(rktio, filename, NULL, &isdir, &islink, NULL, NULL, NULL, -1)) {
if (islink) {
if (isdir)
return RKTIO_FILE_TYPE_DIRECTORY_LINK;
else
return RKTIO_FILE_TYPE_LINK;
} else if (isdir)
return RKTIO_FILE_TYPE_DIRECTORY;
else
return RKTIO_FILE_TYPE_FILE;
} else
return RKTIO_FILE_TYPE_ERROR;
}
#else
{
struct MSC_IZE(stat) buf;
while (1) {
if (!MSC_W_IZE(lstat)(MSC_WIDE_PATH_temp(filename), &buf))
break;
else if (errno != EINTR)
return RKTIO_FILE_TYPE_ERROR;
}
if (S_ISLNK(buf.st_mode))
return RKTIO_FILE_TYPE_LINK;
else if (S_ISDIR(buf.st_mode))
return RKTIO_FILE_TYPE_DIRECTORY;
else
return RKTIO_FILE_TYPE_FILE;
}
#endif
}
char *rktio_get_current_directory(rktio_t *rktio) char *rktio_get_current_directory(rktio_t *rktio)
{ {
#ifdef RKTIO_SYSTEM_WINDOWS #ifdef RKTIO_SYSTEM_WINDOWS