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

`file-or-directory-permissions': expose more info, add write mode

Browse Source 
and add `user-read-bit', etc., to `racket/file'
This commit is contained in:
Matthew Flatt 2011-03-10 15:49:11 -06:00
parent 3249ca2ab8
commit a5a7076fe0
6 changed files with 244 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/racket/file.rkt
View File

@ -24,7 +24,18 @@
file->list
display-to-file
write-to-file
display-lines-to-file)
display-lines-to-file
user-read-bit
user-write-bit
user-execute-bit
group-read-bit
group-write-bit
group-execute-bit
other-read-bit
other-write-bit
other-execute-bit)
(require "private/portlines.rkt")
@ -587,3 +598,13 @@
(raise-type-error 'display-lines-to-file "list" l))
(->file 'display-lines-to-file f mode exists
(lambda (p) (do-lines->port l p newline))))
(define user-read-bit #o100)
(define user-write-bit #o200)
(define user-execute-bit #o400)
(define group-read-bit #o010)
(define group-write-bit #o020)
(define group-execute-bit #o040)
(define other-read-bit #o001)
(define other-write-bit #o002)
(define other-execute-bit #o004)

64
collects/scribblings/reference/filesystem.scrbl
View File

@ -286,13 +286,46 @@ called, and the default @racket[fail-thunk] raises
@racket[exn:fail:filesystem].}
@defproc[(file-or-directory-permissions [path path-string?]) (listof symbol?)]{
@defproc*[([(file-or-directory-permissions [path path-string?] [mode #f #f]) (listof (or/c 'read 'write 'execute))]
[(file-or-directory-permissions [path path-string?] [mode 'bits]) (integer-in 0 #xFFFF)]
[(file-or-directory-permissions [path path-string?] [mode (integer-in 0 #xFFFF)]) void])]{
Returns a list containing @indexed-racket['read],
@indexed-racket['write], and/or @indexed-racket['execute] for the
given file or directory path. On error (e.g., if no such file exists),
the @exnraise[exn:fail:filesystem]. Under @|AllUnix|, permissions are
checked for the current effective user instead of the real user.}
When given one argument or @racket[#f] as the second argument, returns
a list containing @indexed-racket['read], @indexed-racket['write],
and/or @indexed-racket['execute] to indicate permission the given file
or directory path by the current user and group. Under @|AllUnix|,
permissions are checked for the current effective user instead of the
real user.
If @racket['bits] is supplied as the second argument, the result is a
platform-specific integer encoding of the file or directory properties
(mostly permissions), and the result is independent of the current
user and group. The lowest nine bits of the encoding are somewhat
portable, reflecting permissions for the file or directory's owner,
members of the file or directory's group, or other users:
@itemlist[
@item{@racketvalfont{#o100} : owner has read permission}
@item{@racketvalfont{#o200} : owner has write permission}
@item{@racketvalfont{#o400} : owner has execute permission}
@item{@racketvalfont{#o010} : group has read permission}
@item{@racketvalfont{#o020} : group has write permission}
@item{@racketvalfont{#o040} : group has execute permission}
@item{@racketvalfont{#o001} : others have read permission}
@item{@racketvalfont{#o002} : others have write permission}
@item{@racketvalfont{#o004} : others have execute permission}
]
See also @racket[user-read-bit], etc. Under Windows, permissions from
all three (owner, group, and others) are always the same, and read and
execute permission are always available. Under @|AllUnix|,
higher bits have a platform-specific meaning.
If an integer is supplied as the second argument, its is used as an
encoding of properties (mostly permissions) to install for the file.
In all modes, the @exnraise[exn:fail:filesystem] on error (e.g., if no
such file exists).}
@defproc[(file-or-directory-identity [path path-string?]
@ -1065,11 +1098,26 @@ on @racket[filename] would interfere with replacing @racket[filename]] via
[(make-lock-file-name [dir path-string?] [name path-string?]) path-string?])]{
Creates a lock filename by prepending @racket["_LOCK"] on windows or @racket[".LOCK"] on all other platforms
to the file portion of the path.
}
@examples[
#:eval file-eval
(make-lock-file-name "/home/george/project/important-file")]
(make-lock-file-name "/home/george/project/important-file")]}
@deftogether[(
@defthing[user-read-bit @#,schemevalfont{#o100}]
@defthing[user-write-bit @#,schemevalfont{#o200}]
@defthing[user-execute-bit @#,schemevalfont{#o400}]
@defthing[group-read-bit @#,schemevalfont{#o010}]
@defthing[group-write-bit @#,schemevalfont{#o020}]
@defthing[group-execute-bit @#,schemevalfont{#o040}]
@defthing[other-read-bit @#,schemevalfont{#o001}]
@defthing[other-write-bit @#,schemevalfont{#o002}]
@defthing[other-execute-bit @#,schemevalfont{#o004}]
)]{
Constants that are useful with @racket[file-or-directory-permissions]
and bitwise operations such as @racket[bitwise-ior], and
@racket[bitwise-and].}
@(interaction-eval #:eval file-eval (delete-file filename))

6
collects/tests/racket/file.rktl
View File

@ -666,6 +666,9 @@
(close-input-port p)
(close-input-port q))
;; We should be able to install the current permissions:
(test (void) file-or-directory-permissions "tmp1" (file-or-directory-permissions "tmp1" 'bits))
(define test-file
(open-output-file "tmp2" #:exists 'truncate))
(write-char #\; test-file)
@ -1459,6 +1462,9 @@
(err/rt-test (rename-file-or-directory "tmp1" "tmp11") (fs-reject? 'rename-file-or-directory))
(err/rt-test (copy-file "tmp1" "tmp11") (fs-reject? 'copy-file))
(err/rt-test (make-file-or-directory-link "tmp1" "tmp11") (fs-reject? 'make-file-or-directory-link))
(err/rt-test (file-or-directory-permissions "tmp1" 7) (fs-reject? 'file-or-directory-permissions))
(err/rt-test (file-or-directory-permissions "tmp1" 0) (fs-reject? 'file-or-directory-permissions))
(test #t exact-integer? (file-or-directory-permissions "tmp1" 'bits))
(let ([p (open-input-file "tmp1")])
(test #t input-port? p)
(close-input-port p))

5
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,8 @@
Version 5.1.0.4
Change file-or-directory-permission to add 'bits mode
and permission-setting mode
racket/file: add user-read-bit, etc.
Version 5.1.0.2
Enabled single-precision floats by default
Added single-flonum?

217
src/racket/src/file.c
View File

@ -495,7 +495,7 @@ void scheme_init_file(Scheme_Env *env)
scheme_add_global_constant("file-or-directory-permissions",
scheme_make_prim_w_arity(file_or_dir_permissions,
"file-or-directory-permissions",
1, 1),
1, 2),
env);
scheme_add_global_constant("file-or-directory-identity",
scheme_make_prim_w_arity(file_identity,
@ -2102,7 +2102,7 @@ static time_t convert_date(const FILETIME *ft)
# define MZ_UNC_EXEC 0x4
static int UNC_stat(char *dirname, int len, int *flags, int *isdir, Scheme_Object **date,
mzlonglong *filesize)
mzlonglong *filesize, int set_flags)
/* dirname must be absolute */
{
/* Note: stat() doesn't work with UNC "drive" names or \\?\ paths.
@ -2147,22 +2147,36 @@ static int UNC_stat(char *dirname, int len, int *flags, int *isdir, Scheme_Objec
errno = -1;
return 0;
} else {
if (must_be_dir && !(GET_FF_ATTRIBS(fd) & FF_A_DIR))
return 0;
if (flags)
*flags = MZ_UNC_READ | MZ_UNC_EXEC | ((GET_FF_ATTRIBS(fd) & FF_A_RDONLY) ? 0 : MZ_UNC_WRITE);
if (date) {
Scheme_Object *dt;
time_t mdt;
mdt = GET_FF_MODDATE(fd);
dt = scheme_make_integer_value_from_time(mdt);
*date = dt;
}
if (isdir) {
*isdir = (GET_FF_ATTRIBS(fd) & FF_A_DIR);
}
if (filesize) {
*filesize = ((mzlonglong)fd.nFileSizeHigh << 32) | fd.nFileSizeLow;
if (set_flags != -1) {
DWORD attrs = GET_FF_ATTRIBS(fd);
if (!(set_flags & MZ_UNC_WRITE))
attrs |= FF_A_RDONLY;
else if (attrs & FF_A_RDONLY)
attrs -= FF_A_RDONLY;
if (!SetFileAttributesW(WIDE_PATH(copy), attrs)) {
errno = -1;
return 0;
}
} else {
if (must_be_dir && !(GET_FF_ATTRIBS(fd) & FF_A_DIR))
return 0;
if (flags)
*flags = MZ_UNC_READ | MZ_UNC_EXEC | ((GET_FF_ATTRIBS(fd) & FF_A_RDONLY) ? 0 : MZ_UNC_WRITE);
if (date) {
Scheme_Object *dt;
time_t mdt;
mdt = GET_FF_MODDATE(fd);
dt = scheme_make_integer_value_from_time(mdt);
*date = dt;
}
if (isdir) {
*isdir = (GET_FF_ATTRIBS(fd) & FF_A_DIR);
}
if (filesize) {
*filesize = ((mzlonglong)fd.nFileSizeHigh << 32) | fd.nFileSizeLow;
}
}
return 1;
}
@ -2188,7 +2202,7 @@ int scheme_file_exists(char *filename)
{
int isdir;
return (UNC_stat(filename, strlen(filename), NULL, &isdir, NULL, NULL)
return (UNC_stat(filename, strlen(filename), NULL, &isdir, NULL, NULL, -1)
&& !isdir);
}
# else
@ -2212,7 +2226,7 @@ int scheme_directory_exists(char *dirname)
# ifdef DOS_FILE_SYSTEM
int isdir;
return (UNC_stat(dirname, strlen(dirname), NULL, &isdir, NULL, NULL)
return (UNC_stat(dirname, strlen(dirname), NULL, &isdir, NULL, NULL, -1)
&& isdir);
# else
struct MSC_IZE(stat) buf;
@ -5283,7 +5297,7 @@ static Scheme_Object *file_modify_seconds(int argc, Scheme_Object **argv)
int len = strlen(file);
Scheme_Object *secs;
if (UNC_stat(file, len, NULL, NULL, &secs, NULL))
if (UNC_stat(file, len, NULL, NULL, &secs, NULL, -1))
return secs;
} else
# endif
@ -5359,14 +5373,38 @@ static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[])
{
Scheme_Object *l = scheme_null;
char *filename;
int as_bits = 0, set_bits = 0, new_bits = 0;
int err_val = 0;
if (!SCHEME_PATH_STRINGP(argv[0]))
scheme_wrong_type("file-or-directory-permissions", SCHEME_PATH_STRING_STR, 0, argc, argv);
if (argc > 1) {
l = argv[1];
if (SCHEME_FALSEP(l)) {
} else if (SCHEME_SYMBOLP(l) && !SCHEME_SYM_WEIRDP(l)
&& !strcmp("bits", SCHEME_SYM_VAL(l))) {
as_bits = 1;
} else {
as_bits = -1;
l = argv[1];
if (SCHEME_INTP(l)
&& (SCHEME_INT_VAL(l) >= 0)
&& (SCHEME_INT_VAL(l) <= 0xFFFF)) {
set_bits = 1;
new_bits = SCHEME_INT_VAL(l);
} else
scheme_wrong_type("file-or-directory-permissions",
"#f, 'bits, or an exact integer in [0, 65535]",
1, argc, argv);
}
}
filename = scheme_expand_string_filename(argv[0],
"file-or-directory-permissions",
NULL,
SCHEME_GUARD_FILE_READ);
(set_bits
? SCHEME_GUARD_FILE_WRITE
: SCHEME_GUARD_FILE_READ));
# ifdef NO_STAT_PROC
return scheme_null;
@ -5383,7 +5421,7 @@ static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[])
egid = getegid();
}
if ((uid == euid) && (gid == egid)) {
if (!as_bits && (uid == euid) && (gid == egid)) {
/* Not setuid; use access() */
int read, write, execute, ok;
@ -5430,68 +5468,119 @@ static Scheme_Object *file_or_dir_permissions(int argc, Scheme_Object *argv[])
{
/* Use stat, because setuid, or because or no user info available */
struct stat buf;
int read, write, execute;
int ok, read, write, execute;
if (stat(filename, &buf))
do {
ok = stat(filename, &buf);
} while ((ok == -1) && (errno == EINTR));
if (ok)
l = NULL;
else {
if (as_bits) {
if (set_bits) {
do {
ok = chmod(filename, new_bits);
} while ((ok == -1) && (errno == EINTR));
if (ok)
l = NULL;
else
l = scheme_void;
} else {
int bits = buf.st_mode;
# ifdef S_IFMT
bits -= (bits & S_IFMT);
# endif
l = scheme_make_integer(bits);
}
} else {
# ifndef NO_UNIX_USERS
if (euid == 0) {
/* Super-user can read/write anything, and can
execute anything that someone can execute */
read = 1;
write = 1;
execute = !!(buf.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH));
} else if (buf.st_uid == euid) {
read = !!(buf.st_mode & S_IRUSR);
write = !!(buf.st_mode & S_IWUSR);
execute = !!(buf.st_mode & S_IXUSR);
} else if ((egid == buf.st_gid) || user_in_group(euid, buf.st_gid)) {
read = !!(buf.st_mode & S_IRGRP);
write = !!(buf.st_mode & S_IWGRP);
execute = !!(buf.st_mode & S_IXGRP);
} else {
read = !!(buf.st_mode & S_IROTH);
write = !!(buf.st_mode & S_IWOTH);
execute = !!(buf.st_mode & S_IXOTH);
}
if (euid == 0) {
/* Super-user can read/write anything, and can
execute anything that someone can execute */
read = 1;
write = 1;
execute = !!(buf.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH));
} else if (buf.st_uid == euid) {
read = !!(buf.st_mode & S_IRUSR);
write = !!(buf.st_mode & S_IWUSR);
execute = !!(buf.st_mode & S_IXUSR);
} else if ((egid == buf.st_gid) || user_in_group(euid, buf.st_gid)) {
read = !!(buf.st_mode & S_IRGRP);
write = !!(buf.st_mode & S_IWGRP);
execute = !!(buf.st_mode & S_IXGRP);
} else {
read = !!(buf.st_mode & S_IROTH);
write = !!(buf.st_mode & S_IWOTH);
execute = !!(buf.st_mode & S_IXOTH);
}
# else
read = !!(buf.st_mode & (S_IRUSR | S_IRGRP | S_IROTH));
write = !!(buf.st_mode & (S_IWUSR | S_IWGRP | S_IWOTH));
execute = !!(buf.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH));
read = !!(buf.st_mode & (S_IRUSR | S_IRGRP | S_IROTH));
write = !!(buf.st_mode & (S_IWUSR | S_IWGRP | S_IWOTH));
execute = !!(buf.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH));
# endif
if (read)
l = scheme_make_pair(read_symbol, l);
if (write)
l = scheme_make_pair(write_symbol, l);
if (execute)
l = scheme_make_pair(execute_symbol, l);
if (read)
l = scheme_make_pair(read_symbol, l);
if (write)
l = scheme_make_pair(write_symbol, l);
if (execute)
l = scheme_make_pair(execute_symbol, l);
}
}
}
if (!l)
err_val = errno;
# endif
# ifdef DOS_FILE_SYSTEM
{
int len = strlen(filename);
int flags;
if (UNC_stat(filename, len, &flags, NULL, NULL, NULL)) {
if (flags & MZ_UNC_READ)
l = scheme_make_pair(read_symbol, l);
if (flags & MZ_UNC_WRITE)
l = scheme_make_pair(write_symbol, l);
if (flags & MZ_UNC_EXEC)
l = scheme_make_pair(execute_symbol, l);
if (set_bits) {
int ALWAYS_SET_BITS = ((MZ_UNC_READ | MZ_UNC_EXEC)
| ((MZ_UNC_READ | MZ_UNC_EXEC) << 3)
| ((MZ_UNC_READ | MZ_UNC_EXEC) << 6));
if (((new_bits & ALWAYS_SET_BITS) != ALWAYS_SET_BITS)
|| ((new_bits & MZ_UNC_WRITE) != ((new_bits & (MZ_UNC_WRITE << 3)) >> 3))
|| ((new_bits & MZ_UNC_WRITE) != ((new_bits & (MZ_UNC_WRITE << 6)) >> 6))
|| (new_bits >= (1 << 9)))
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"file-or-directory-permissions: update of \"%q\" failed:"
" unsupported bit combination in %d",
filename_for_error(argv[0]),
new_bits);
l = scheme_void;
} else
new_bits = -1;
if (UNC_stat(filename, len, &flags, NULL, NULL, NULL, new_bits)) {
if (set_bits)
l = scheme_void;
else if (as_bits)
l = scheme_make_integer(flags | (flags << 3) | (flags << 6));
else {
if (flags & MZ_UNC_READ)
l = scheme_make_pair(read_symbol, l);
if (flags & MZ_UNC_WRITE)
l = scheme_make_pair(write_symbol, l);
if (flags & MZ_UNC_EXEC)
l = scheme_make_pair(execute_symbol, l);
}
} else {
l = NULL;
err_val = GetLastError();
}
}
# endif
# endif
if (!l) {
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"file-or-directory-permissions: file or directory not found: \"%q\"",
filename_for_error(argv[0]));
"file-or-directory-permissions: %s of \"%q\" failed: %e",
set_bits ? "update" : "access",
filename_for_error(argv[0]),
err_val);
}
return l;
@ -5531,7 +5620,7 @@ static Scheme_Object *file_size(int argc, Scheme_Object *argv[])
#ifdef DOS_FILE_SYSTEM
{
if (UNC_stat(filename, strlen(filename), NULL, NULL, NULL, &len)) {
if (UNC_stat(filename, strlen(filename), NULL, NULL, NULL, &len, -1)) {
return scheme_make_integer_value_from_long_long(len);
}
}

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.1.0.3"
#define MZSCHEME_VERSION "5.1.0.4"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)