From 1c04cf1b020d78ac95a150b82266c963d0cc7d17 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 11 Aug 2011 12:58:53 -0600 Subject: [PATCH] make `port-try-file-lock?' work for Solaris 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,...). --- collects/racket/file.rkt | 4 +- .../scribblings/reference/file-ports.scrbl | 15 +- .../scribblings/reference/filesystem.scrbl | 1 - collects/tests/racket/file.rktl | 15 +- src/racket/include/schthread.h | 4 + src/racket/sconfig.h | 4 + src/racket/src/port.c | 220 ++++++++++++++++-- 7 files changed, 233 insertions(+), 30 deletions(-) diff --git a/collects/racket/file.rkt b/collects/racket/file.rkt index 942d25c98b..7851d0c361 100644 --- a/collects/racket/file.rkt +++ b/collects/racket/file.rkt @@ -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) diff --git a/collects/scribblings/reference/file-ports.scrbl b/collects/scribblings/reference/file-ports.scrbl index 9972d4e59c..7b80dcba67 100644 --- a/collects/scribblings/reference/file-ports.scrbl +++ b/collects/scribblings/reference/file-ports.scrbl @@ -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?]) diff --git a/collects/scribblings/reference/filesystem.scrbl b/collects/scribblings/reference/filesystem.scrbl index d12b1c99e5..84493ba2a0 100644 --- a/collects/scribblings/reference/filesystem.scrbl +++ b/collects/scribblings/reference/filesystem.scrbl @@ -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 diff --git a/collects/tests/racket/file.rktl b/collects/tests/racket/file.rktl index 622982787c..e1d14de835 100644 --- a/collects/tests/racket/file.rktl +++ b/collects/tests/racket/file.rktl @@ -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) diff --git a/src/racket/include/schthread.h b/src/racket/include/schthread.h index 7b0810f89e..271725e7e4 100644 --- a/src/racket/include/schthread.h +++ b/src/racket/include/schthread.h @@ -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_) diff --git a/src/racket/sconfig.h b/src/racket/sconfig.h index bf24573860..2764e12562 100644 --- a/src/racket/sconfig.h +++ b/src/racket/sconfig.h @@ -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. */ diff --git a/src/racket/src/port.c b/src/racket/src/port.c index 302eb60425..2bcb0299a7 100644 --- a/src/racket/src/port.c +++ b/src/racket/src/port.c @@ -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;