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

make `port-try-file-lock?' work for Solaris

Browse Source 
Shared locking now allowed only on input port, and exclusive
locking is allowed only on output ports, which allows an implementation
via fcntl(...,F_SETLK,...).
This commit is contained in:
Matthew Flatt 2011-08-11 12:58:53 -06:00
parent 997813680d
commit 1c04cf1b02
7 changed files with 233 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/racket/file.rkt
View File

@ -235,7 +235,9 @@
(unless (file-exists? lock-file)
(with-handlers ([exn:fail:filesystem:exists? (lambda (exn) 'ok)])
(close-output-port (open-output-file lock-file #:exists 'error))))
((call-with-input-file*
(((if (eq? kind 'exclusive)
(lambda (fn proc) (call-with-output-file fn proc #:exists 'update))
call-with-input-file*)
lock-file
(lambda (p)
(if (port-try-file-lock? p kind)

15
collects/scribblings/reference/file-ports.scrbl
View File

@ -301,11 +301,13 @@ the current output port (see @racket[current-output-port]) using
[mode (or/c 'shared 'exclusive)])
boolean?]{
Attempts to acquire a lock on the file using the current platform's
facilities for file locking. Multiple
processes can acquire a @racket['shared] lock on a file, but at most
one process can hold an @racket['exclusive] lock, and @racket['shared]
and @racket['exclusive] locks are mutually exclusive.
Attempts to acquire a lock on the file using the current platform's
facilities for file locking. Multiple processes can acquire a
@racket['shared] lock on a file, but at most one process can hold an
@racket['exclusive] lock, and @racket['shared] and @racket['exclusive]
locks are mutually exclusive. When @racket[mode] is @racket['shared],
then @racket[port] must be an input port; when @racket[mode] is
@racket['exclusive], then @racket[port] must be an output port.
The result is @racket[#t] if the requested lock is acquired,
@racket[#f] otherwise. When a lock is acquired, it is held until
@ -320,8 +322,7 @@ advisory on other platforms.
Typically, locking is supported only for file ports, and attempting to
acquire a lock with other kinds of file-stream ports raises an
@racket[exn:fail:filesystem] exception. Locking is not supported on Solaris,
where the @racket[exn:fail:unsupported] exception is raised.}
@racket[exn:fail:filesystem] exception.}
@defproc[(port-file-unlock [port file-stream-port?])

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

@ -1044,7 +1044,6 @@ to retry the preferences lookup.
Before calling @racket[get-preference], the result procedure uses
@racket[(sleep delay)] to pause. Then, if @racket[(* 2 delay)] is less
than @racket[max-delay], the result procedure calls
@racket[make-handle-get-preference-locked] to generate a new retry
procedure to pass to @racket[get-preference], but with a
@racket[delay] of @racket[(* 2 delay)]. If @racket[(* 2 delay)] is not

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

@ -679,20 +679,25 @@
(close-output-port test-file)
(check-test-file "tmp2")
(let ([p (open-input-file "tmp2")])
(let-values ([(p p-out) (open-input-output-file "tmp2" #:exists 'update)])
(test #t port-try-file-lock? p 'shared)
(let ([p2 (open-input-file "tmp2")])
(test #t port-try-file-lock? p2 'shared)
(test #t port-try-file-lock? p2 'shared)
(test (void) port-file-unlock p2)
(close-input-port p2))
(let ([p3 (open-input-file "tmp2")])
(let ([p3 (open-output-file "tmp2" #:exists 'update)])
(test #f port-try-file-lock? p3 'exclusive)
(test (void) port-file-unlock p)
(test #t port-try-file-lock? p3 'exclusive)
(test #t port-try-file-lock? p3 'exclusive)
(test #f port-try-file-lock? p 'shared)
(close-input-port p3))
(test #t port-try-file-lock? p 'exclusive)
(close-input-port p))
(close-output-port p3))
(err/rt-test (port-try-file-lock? p 'exclusive))
(err/rt-test (port-try-file-lock? p-out 'shared))
(test #t port-try-file-lock? p-out 'exclusive)
(close-input-port p)
(close-output-port p-out))
(define ui (make-input-port 'name (lambda (s) (bytes-set! s 0 (char->integer #\")) 1) #f void))
(test "" read ui)

4
src/racket/include/schthread.h
View File

@ -173,6 +173,9 @@ typedef struct Thread_Local_Variables {
struct Scheme_Object *scheme_orig_stderr_port_;
struct Scheme_Object *scheme_orig_stdin_port_;
struct mz_fd_set *scheme_fd_set_;
#ifdef USE_FCNTL_AND_FORK_FOR_FILE_LOCKS
struct Scheme_Hash_Table *locked_fd_process_map_;
#endif
struct Scheme_Custodian *new_port_cust_;
#if (defined(__WIN32__) || defined(WIN32) || defined(_WIN32))
void *scheme_break_semaphore_;
@ -507,6 +510,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define scheme_orig_stderr_port XOA (scheme_get_thread_local_variables()->scheme_orig_stderr_port_)
#define scheme_orig_stdin_port XOA (scheme_get_thread_local_variables()->scheme_orig_stdin_port_)
#define scheme_fd_set XOA (scheme_get_thread_local_variables()->scheme_fd_set_)
#define locked_fd_process_map XOA (scheme_get_thread_local_variables()->locked_fd_process_map_)
#define new_port_cust XOA (scheme_get_thread_local_variables()->new_port_cust_)
#define scheme_break_semaphore XOA (scheme_get_thread_local_variables()->scheme_break_semaphore_)
#define external_event_fd XOA (scheme_get_thread_local_variables()->external_event_fd_)

4
src/racket/sconfig.h
View File

@ -100,6 +100,7 @@
# define SOME_FDS_ARE_NOT_SELECTABLE
# define NEED_RESET_STDOUT_BLOCKING
# undef USE_FLOCK_FOR_FILE_LOCKS
# define USE_FCNTL_AND_FORK_FOR_FILE_LOCKS
# define USE_TIMEZONE_AND_ALTZONE_VAR
# define USE_NULL_TO_DISCONNECT_UDP
# else
@ -1055,6 +1056,9 @@
/* USE_FLOCK_FOR_FILE_LOCKS means that flock() is available and works
for file locking. */
/* USE_FCNTL_AND_FORK_FOR_FILE_LOCKS means that fnctl() and fork()
should be used to implement file locking. */
/* CLOSE_ALL_FDS_AFTER_FORK means that all fds except 0, 1, and 2
should be closed after performing a fork() for `process'
and `system' calls. */

220
src/racket/src/port.c
View File

@ -199,6 +199,10 @@ typedef struct Scheme_Subprocess {
# define MZ_FDS
#endif
#ifdef CLOSE_ALL_FDS_AFTER_FORK
static void close_fds_after_fork(int skip1, int skip2, int skip3);
#endif
/******************** refcounts ********************/
#if defined(WINDOWS_FILE_HANDLES) || defined(MZ_USE_PLACES)
@ -314,6 +318,11 @@ THREAD_LOCAL_DECL(Scheme_Object *scheme_orig_stdin_port);
THREAD_LOCAL_DECL(struct mz_fd_set *scheme_fd_set);
#ifdef USE_FCNTL_AND_FORK_FOR_FILE_LOCKS
THREAD_LOCAL_DECL(Scheme_Hash_Table *locked_fd_process_map);
static void release_lockf(int fd);
#endif
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stdin)(void) = NULL;
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stdout)(void) = NULL;
HOOK_SHARED_OK Scheme_Object *(*scheme_make_stderr)(void) = NULL;
@ -4840,10 +4849,136 @@ static int try_lock(int fd, int writer, int *_errid)
*_errid = errno;
return 0;
}
# elif defined(USE_FCNTL_AND_FORK_FOR_FILE_LOCKS)
/* An lockf() is cancelled if *any* file descriptor to the same file
is closed within the same process. We avoid that problem by forking
a new process whose only job is to use lockf(). */
{
int ifds[2], ofds[2], cr;
if (locked_fd_process_map)
if (scheme_hash_get(locked_fd_process_map, scheme_make_integer(fd)))
/* already have a lock */
return 1;
if (!pipe(ifds)) {
if (!pipe(ofds)) {
int pid;
pid = fork();
if (pid > 0) {
/* Original process: */
int errid = 0;
do {
cr = close(ifds[1]);
} while ((cr == -1) && (errno == EINTR));
do {
cr = close(ofds[0]);
} while ((cr == -1) && (errno == EINTR));
do{
cr = read(ifds[0], &errid, sizeof(int));
} while ((cr == -1) && (errno == EINTR));
if (cr == -1)
errid = errno;
do {
cr = close(ifds[0]);
} while ((cr == -1) && (errno == EINTR));
if (errid) {
do {
cr = close(ofds[1]);
} while ((cr == -1) && (errno == EINTR));
if (errid == EAGAIN)
*_errid = 0;
else
*_errid = errid;
return 0;
} else {
/* got lock; record fd -> pipe mapping */
if (!locked_fd_process_map) {
REGISTER_SO(locked_fd_process_map);
locked_fd_process_map = scheme_make_hash_table(SCHEME_hash_ptr);
}
scheme_hash_set(locked_fd_process_map,
scheme_make_integer(fd),
scheme_make_pair(scheme_make_integer(ofds[1]),
scheme_make_integer(pid)));
return 1;
}
} else if (!pid) {
/* Child process */
int ok = 0;
struct flock fl;
do {
cr = close(ifds[0]);
} while ((cr == -1) && (errno == EINTR));
do {
cr = close(ofds[1]);
} while ((cr == -1) && (errno == EINTR));
#ifdef CLOSE_ALL_FDS_AFTER_FORK
close_fds_after_fork(ifds[1], ofds[0], fd);
#endif
fl.l_start = 0;
fl.l_len = 0;
fl.l_type = (writer ? F_WRLCK : F_RDLCK);
fl.l_whence = SEEK_SET;
fl.l_pid = getpid();
if (!fcntl(fd, F_SETLK, &fl)) {
/* report success: */
do {
cr = write(ifds[1], &ok, sizeof(int));
} while ((cr == -1) && (errno == EINTR));
/* wait until a signal to exit: */
do {
cr = read(ofds[0], &ok, sizeof(int));
} while ((cr == -1) && (errno == EINTR));
}
if (!ok) {
int errid = errno;
do {
cr = write(ifds[1], &errid, sizeof(int));
} while ((cr == -1) && (errno == EINTR));
}
_exit(0);
} else {
int i;
*_errid = errno;
for (i = 0; i < 2; i++) {
do {
cr = close(ifds[i]);
} while ((cr == -1) && (errno == EINTR));
do {
cr = close(ofds[i]);
} while ((cr == -1) && (errno == EINTR));
}
return 0;
}
} else {
int i;
*_errid = errno;
for (i = 0; i < 2; i++) {
do {
cr = close(ifds[i]);
} while ((cr == -1) && (errno == EINTR));
}
return 0;
}
} else {
*_errid = errno;
return 0;
}
}
# else
/* using fcntl(F_SETFL, ...) isn't really an option, since the
any-close-release-the-lock semantics of fcntl()-based locks
doesn't work with Racket threads that compete for a lock */
*_errid = ENOTSUP;
return 0;
# endif
@ -4913,6 +5048,15 @@ Scheme_Object *scheme_file_try_lock(int argc, Scheme_Object **argv)
if (writer == -1)
scheme_wrong_type("port-try-file-lock?", "'shared or 'exclusive", 1, argc, argv);
if (writer && !SCHEME_OUTPORTP(argv[0]))
scheme_arg_mismatch("port-try-file-lock?",
"port for 'exclusive locking is not an output port: ",
argv[0]);
else if (!writer && !SCHEME_INPORTP(argv[0]))
scheme_arg_mismatch("port-try-file-lock?",
"port for 'shared locking is not an input port: ",
argv[0]);
check_already_closed("port-try-file-lock?", argv[0]);
if (try_lock(fd, writer, &errid))
@ -4928,6 +5072,30 @@ Scheme_Object *scheme_file_try_lock(int argc, Scheme_Object **argv)
return scheme_false;
}
#ifdef USE_FCNTL_AND_FORK_FOR_FILE_LOCKS
static void release_lockf(int fd)
{
if (locked_fd_process_map) {
Scheme_Object *v;
v = scheme_hash_get(locked_fd_process_map, scheme_make_integer(fd));
if (v) {
int fd2, cr, pid, status;
fd2 = SCHEME_INT_VAL(SCHEME_CAR(v));
pid = SCHEME_INT_VAL(SCHEME_CDR(v));
scheme_hash_set(locked_fd_process_map, scheme_make_integer(fd), NULL);
scheme_block_child_signals(1);
do {
cr = close(fd2); /* makes the fork()ed process exit */
} while ((cr == -1) && (errno == EINTR));
waitpid(pid, &status, 0);
scheme_block_child_signals(0);
}
}
}
#endif
Scheme_Object *scheme_file_unlock(int argc, Scheme_Object **argv)
{
int ok, errid;
@ -4945,6 +5113,10 @@ Scheme_Object *scheme_file_unlock(int argc, Scheme_Object **argv)
} while ((ok == -1) && (errno == EINTR));
ok = !ok;
errid = errno;
# elif defined(USE_FCNTL_AND_FORK_FOR_FILE_LOCKS)
release_lockf(fd);
ok = 1;
errid = 0;
# else
ok = 0;
errid = ENOTSUP;
@ -5556,6 +5728,9 @@ fd_close_input(Scheme_Input_Port *port)
do {
cr = close(fip->fd);
} while ((cr == -1) && (errno == EINTR));
# ifdef USE_FCNTL_AND_FORK_FOR_FILE_LOCKS
release_lockf(fip->fd);
# endif
}
}
#endif
@ -6835,6 +7010,9 @@ fd_close_output(Scheme_Output_Port *port)
do {
cr = close(fop->fd);
} while ((cr == -1) && (errno == EINTR));
# ifdef USE_FCNTL_AND_FORK_FOR_FILE_LOCKS
release_lockf(fop->fd);
# endif
}
}
#endif
@ -8340,19 +8518,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
}
#ifdef CLOSE_ALL_FDS_AFTER_FORK
/* Actually, unwanted includes everything
except stdio. */
#ifdef USE_ULIMIT
i = ulimit(4, 0);
#else
i = getdtablesize();
#endif
while (i-- > 3) {
int cr;
do {
cr = close(i);
} while ((cr == -1) && (errno == EINTR));
}
close_fds_after_fork(0, 1, 2);
#endif
}
@ -8568,6 +8734,28 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
#endif
}
#ifdef CLOSE_ALL_FDS_AFTER_FORK
static void close_fds_after_fork(int skip1, int skip2, int skip3)
{
int i;
# ifdef USE_ULIMIT
i = ulimit(4, 0);
# else
i = getdtablesize();
# endif
while (i--) {
int cr;
if ((i != skip1) && (i != skip2) && (i != skip3)) {
do {
cr = close(i);
} while ((cr == -1) && (errno == EINTR));
}
}
}
#endif
static Scheme_Object *sch_shell_execute(int c, Scheme_Object *argv[])
{
int show;