diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index ab15f0b1f7..4015bbf33b 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.11.0.3") +(define version "6.11.0.4") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/foreign/derived.scrbl b/pkgs/racket-doc/scribblings/foreign/derived.scrbl index e3d9f61ab3..e113bf8464 100644 --- a/pkgs/racket-doc/scribblings/foreign/derived.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/derived.scrbl @@ -15,6 +15,7 @@ @include-section["atomic.scrbl"] @include-section["try-atomic.scrbl"] @include-section["schedule.scrbl"] +@include-section["port.scrbl"] @include-section["global.scrbl"] @include-section["objc.scrbl"] @include-section["ns.scrbl"] diff --git a/pkgs/racket-doc/scribblings/foreign/port.scrbl b/pkgs/racket-doc/scribblings/foreign/port.scrbl new file mode 100644 index 0000000000..b227eca9b0 --- /dev/null +++ b/pkgs/racket-doc/scribblings/foreign/port.scrbl @@ -0,0 +1,92 @@ +#lang scribble/doc +@(require "utils.rkt" + (for-label ffi/unsafe/port)) + +@title{Ports} + +@defmodule[ffi/unsafe/port]{The +@racketmodname[ffi/unsafe/port] library provides functions for working +with ports, file descriptors, and sockets. The library's operations +are unsafe, because no checking is performed on file descriptors and +sockets, and misuse of file descriptors and sockets can break other +objects.} + +@history[#:added "6.11.0.4"] + +@deftogether[( +@defproc[(unsafe-file-descriptor->port [fd exact-integer?] + [name any/c] + [mode (listof (or/c 'read 'write 'text 'regular-file))]) + (or/c port? (values input-port? output-port?))] +@defproc[(unsafe-socket->port [socket exact-integer?] + [name bytes?] + [mode (listof (or/c 'no-close))]) + (values input-port? output-port?)] +)]{ + +Returns an input port and/or output port for the given file descriptor +or socket. On Windows, a ``file descriptor'' corresponds to a file +@tt{HANDLE}, while a socket corresponds to a @tt{SOCKET}. One Unix, a +socket is a file descriptor, but using socket-specific functions may +enable socket-specific functionality. + +The @racket[name] argument determines the port's name as reported by +@racket[object-name]. The @racket[name] must be a UTF-8 encoding that +is converted to a symbol for the socket name. + +For a file descriptor, the @racket[mode] list must include at least +one of @racket['read] or @racket['write], and two ports are returned +if @racket[mode] includes both @racket['read] and @racket['write]. The +@racket['text] mode affects only Windows ports. The +@racket['regular-file] mode indicates that the file descriptor +corresponds to a regular file (which has the property, for example, +that reading never blocks). Closing all returned file-descriptor ports +closes the file descriptor. + +For a socket, the @racket[mode] list can include @racket['no-close], +in which case closing both of the returned ports does not close the +socket. + +For any kind of result port, closing the resulting ports readies and +unregisters any semaphores for the file descriptor or socket that were +previously created with @racket[unsafe-file-descriptor->semaphore] +@racket[unsafe-socket->semaphore].} + + +@deftogether[( +@defproc[(unsafe-port->file-descriptor [p port?]) + (or/c exact-integer? #f)] +@defproc[(unsafe-port->socket [p port?]) + (or/c exact-integer? #f)] +)]{ + +Returns a file descriptor (which is a @tt{HANDLE} value on Windows) of +a socket for @racket[port] if it has one, @racket[#f] otherwise.} + + +@deftogether[( +@defproc[(unsafe-file-descriptor->semaphore [fd exact-integer?] + [mode (or/c 'read 'write 'check-read 'check-write 'remove)]) + (or/c semaphore? #f)] +@defproc[(unsafe-socket->semaphore [socket exact-integer?] + [mode (or/c 'read 'write 'check-read 'check-write 'remove)]) + (or/c semaphore? #f)] +)]{ + +For @racket[mode] as @racket['read] or @racket['write], returns a +semaphore that becomes ready when @racket[fd] or @racket[socket] +becomes ready for reading or writing, respectively. The result is +@racket[#f] if a conversion to a semaphore is not supported for the +current platform or for the given file descriptor or socket. + +The @racket['read-check] and @racket['write-check] modes are like +@racket['read] and @racket['write], but the result if @racket[#f] if a +semaphore is not already generated for the specified file descriptor +or socket in the specified mode. + +The @racket['remove] mode readies and unregisters any semaphores +previously created for the given file descriptor or socket. Semaphores +must be unregistered before the file descriptor or socket is closed. +Beware that closing a port from @racket[unsafe-file-descriptor->port] +or @racket[unsafe-socket->port] will also ready and unregister +semaphores.} diff --git a/pkgs/racket-doc/scribblings/foreign/schedule.scrbl b/pkgs/racket-doc/scribblings/foreign/schedule.scrbl index 0806e435f2..4e9cb7faf3 100644 --- a/pkgs/racket-doc/scribblings/foreign/schedule.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/schedule.scrbl @@ -6,9 +6,9 @@ @defmodule[ffi/unsafe/schedule]{The @racketmodname[ffi/unsafe/schedule] library provides functions for -cooperating with the thread scheduler and manipulating it. These -operations are unsafe because callbacks run in @tech{atomic mode} -and in an unspecified thread.} +cooperating with the thread scheduler and manipulating it. The +library's operations are unsafe because callbacks run in @tech{atomic +mode} and in an unspecified thread.} @history[#:added "6.11.0.1"] diff --git a/pkgs/racket-test-core/tests/racket/portlib.rktl b/pkgs/racket-test-core/tests/racket/portlib.rktl index a184f50d36..15049af01a 100644 --- a/pkgs/racket-test-core/tests/racket/portlib.rktl +++ b/pkgs/racket-test-core/tests/racket/portlib.rktl @@ -5,7 +5,9 @@ (define SLEEP-TIME 0.1) -(require racket/port) +(require racket/port + ffi/unsafe + ffi/unsafe/port) ;; ---------------------------------------- @@ -1240,4 +1242,40 @@ ;; -------------------------------------------------- +(when (memq (system-type) '(unix macosx)) + (define open (get-ffi-obj 'open #f (_fun _path _int -> _int))) + (define O_RDWR #x0002) ; probably + (for ([mode (in-list '((read) (write) (read write)))]) + (define /dev/null-fd (open "/dev/null" O_RDWR)) + (unless (= -1 /dev/null-fd) + (call-with-values (lambda () (unsafe-file-descriptor->port /dev/null-fd 'dev-null mode)) + (case-lambda + [(p) + (test (equal? mode '(read)) input-port? p) + (test (equal? mode '(write)) output-port? p) + (test /dev/null-fd unsafe-port->file-descriptor p) + (define s (unsafe-file-descriptor->semaphore /dev/null-fd (car mode))) + (test #t 'sema (or (semaphore? s) (not s))) + (test s unsafe-file-descriptor->semaphore /dev/null-fd (case (car mode) + [(read) 'check-read] + [(write) 'check-write])) + (when s + (semaphore-wait s) + (unsafe-file-descriptor->semaphore /dev/null-fd 'remove)) + (test #f unsafe-port->socket p) + (if (input-port? p) + (close-input-port p) + (close-output-port p))] + [(i o) + (test #t input-port? i) + (test #t output-port? o) + (test /dev/null-fd unsafe-port->file-descriptor i) + (test /dev/null-fd unsafe-port->file-descriptor o) + (test #f unsafe-port->socket i) + (test #f unsafe-port->socket o) + (close-input-port i) + (close-output-port o)]))))) + +;; -------------------------------------------------- + (report-errs) diff --git a/racket/collects/ffi/unsafe/port.rkt b/racket/collects/ffi/unsafe/port.rkt new file mode 100644 index 0000000000..fe7b3b6796 --- /dev/null +++ b/racket/collects/ffi/unsafe/port.rkt @@ -0,0 +1,9 @@ +#lang racket/base +(require (only-in '#%unsafe + unsafe-file-descriptor->port + unsafe-port->file-descriptor + unsafe-file-descriptor->semaphore + unsafe-socket->port + unsafe-port->socket + unsafe-socket->semaphore)) +(provide (all-from-out '#%unsafe)) diff --git a/racket/collects/racket/unsafe/ops.rkt b/racket/collects/racket/unsafe/ops.rkt index 050428fd77..1705f42a20 100644 --- a/racket/collects/racket/unsafe/ops.rkt +++ b/racket/collects/racket/unsafe/ops.rkt @@ -20,6 +20,12 @@ unsafe-poll-ctx-eventmask-wakeup unsafe-poll-ctx-milliseconds-wakeup unsafe-signal-received unsafe-set-sleep-in-thread! + unsafe-file-descriptor->port + unsafe-port->file-descriptor + unsafe-file-descriptor->semaphore + unsafe-socket->port + unsafe-port->socket + unsafe-socket->semaphore unsafe-thread-at-root unsafe-make-custodian-at-root unsafe-custodian-register diff --git a/racket/src/racket/src/cstartup.inc b/racket/src/racket/src/cstartup.inc index 3bc9c8deac..0f07b6046d 100644 --- a/racket/src/racket/src/cstartup.inc +++ b/racket/src/racket/src/cstartup.inc @@ -1,5 +1,5 @@ { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,50,84,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,52,84,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,54,0,0,0,1,0,0,8,0,18, 0,22,0,26,0,31,0,38,0,42,0,47,0,59,0,66,0,69,0,82,0, 89,0,94,0,103,0,109,0,123,0,137,0,140,0,146,0,157,0,159,0,173, @@ -102,7 +102,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2091); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,50,84,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,52,84,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,183,0,0,0,1,0,0,8,0,16, 0,29,0,34,0,51,0,63,0,85,0,114,0,158,0,164,0,178,0,193,0, 211,0,223,0,239,0,253,0,19,1,39,1,73,1,90,1,107,1,130,1,145, @@ -1011,7 +1011,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 19016); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,50,84,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,52,84,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,15,0,0,0,1,0,0,8,0,23, 0,48,0,65,0,83,0,105,0,128,0,149,0,171,0,181,0,191,0,199,0, 209,0,217,0,0,0,253,1,0,0,3,1,5,105,110,115,112,48,76,35,37, @@ -1042,7 +1042,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 582); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,50,84,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,52,84,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,102,0,0,0,1,0,0,8,0,15, 0,26,0,53,0,59,0,73,0,86,0,112,0,129,0,151,0,159,0,171,0, 186,0,202,0,220,0,241,0,253,0,13,1,36,1,60,1,72,1,103,1,108, @@ -1538,7 +1538,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 10344); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,50,84,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,8,54,46,49,49,46,48,46,52,84,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,18,0,0,0,1,0,0,8,0,18, 0,22,0,28,0,42,0,56,0,68,0,88,0,102,0,117,0,130,0,135,0, 139,0,151,0,235,0,242,0,20,1,0,0,224,1,0,0,3,1,5,105,110, diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index ae9dc64df0..ec9f65c0d8 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -333,6 +333,7 @@ static void init_unsafe(Scheme_Env *env) scheme_init_unsafe_vector(unsafe_env); scheme_init_unsafe_fun(unsafe_env); scheme_init_unsafe_thread(unsafe_env); + scheme_init_unsafe_port(unsafe_env); scheme_init_extfl_unsafe_number(unsafe_env); scheme_init_extfl_unsafe_numarith(unsafe_env); diff --git a/racket/src/racket/src/port.c b/racket/src/racket/src/port.c index 2e616f6a7d..4b3acc2bb3 100644 --- a/racket/src/racket/src/port.c +++ b/racket/src/racket/src/port.c @@ -234,6 +234,13 @@ static void register_subprocess_wait(); static void block_timer_signals(int block); +static Scheme_Object *unsafe_fd_to_port(int, Scheme_Object *[]); +static Scheme_Object *unsafe_port_to_fd(int, Scheme_Object *[]); +static Scheme_Object *unsafe_fd_to_semaphore(int, Scheme_Object *[]); +static Scheme_Object *unsafe_socket_to_port(int, Scheme_Object *[]); +static Scheme_Object *unsafe_port_to_socket(int, Scheme_Object *[]); +static Scheme_Object *unsafe_socket_to_semaphore(int, Scheme_Object *[]); + typedef struct Scheme_Read_Write_Evt { Scheme_Object so; Scheme_Object *port; @@ -403,6 +410,17 @@ void scheme_init_port_wait() filesystem_change_evt_need_wakeup, NULL, 1); } +void scheme_init_unsafe_port (Scheme_Env *env) +{ + GLOBAL_PRIM_W_ARITY("unsafe-file-descriptor->port", unsafe_fd_to_port, 3, 3, env); + GLOBAL_PRIM_W_ARITY("unsafe-port->file-descriptor", unsafe_port_to_fd, 1, 1, env); + GLOBAL_PRIM_W_ARITY("unsafe-file-descriptor->semaphore", unsafe_fd_to_semaphore, 2, 2, env); + + GLOBAL_PRIM_W_ARITY("unsafe-socket->port", unsafe_socket_to_port, 3, 3, env); + GLOBAL_PRIM_W_ARITY("unsafe-port->socket", unsafe_port_to_socket, 1, 1, env); + GLOBAL_PRIM_W_ARITY("unsafe-socket->semaphore", unsafe_socket_to_semaphore, 2, 2, env); +} + void scheme_init_port_places(void) { @@ -3408,6 +3426,142 @@ intptr_t scheme_get_port_fd(Scheme_Object *p) return -1; } +static Scheme_Object *unsafe_handle_to_port(const char *who, int argc, Scheme_Object *argv[], int socket) +{ + Scheme_Object *name = argv[1], *l, *a; + intptr_t s; + int closemode = 1; + int regfile = 0; + int textmode = 0; + int readmode = 0, writemode = 0; + + if (!scheme_get_int_val(argv[0], &s)) + scheme_wrong_contract(who, "handle-integer?", 0, argc, argv); + + if (socket) { + if (!SCHEME_BYTE_STRINGP(name)) + scheme_wrong_contract(who, "bytes?", 1, argc, argv); + } + + l = argv[2]; + while (SCHEME_PAIRP(l)) { + a = SCHEME_CAR(l); + if (!SCHEME_SYMBOLP(a) || SCHEME_SYM_WEIRDP(a)) + break; + if (socket) { + if (!strcmp(SCHEME_SYM_VAL(a), "no-close")) + closemode = 0; + } else { + if (!strcmp(SCHEME_SYM_VAL(a), "read")) + readmode = 1; + else if (!strcmp(SCHEME_SYM_VAL(a), "write")) + writemode = 1; + else if (!strcmp(SCHEME_SYM_VAL(a), "text")) + textmode = 1; + else if (!strcmp(SCHEME_SYM_VAL(a), "regular-file")) + regfile = 1; + else + break; + } + l = SCHEME_CDR(l); + } + if (!SCHEME_NULLP(l)) + scheme_wrong_contract(who, "mode-symbol-list?", 2, argc, argv); + + if (socket) { + Scheme_Object *p[2]; + scheme_socket_to_ports(s, SCHEME_BYTE_STR_VAL(name), closemode, &p[0], &p[1]); + return scheme_values(2, p); + } else if (writemode) + return scheme_make_fd_output_port(s, name, regfile, textmode, readmode); + else if (readmode) + return scheme_make_fd_input_port(s, name, regfile, textmode); + else { + scheme_contract_error(who, + "mode list must include at least one of 'read or 'write" + "mode list", 1, argv[2], + NULL); + return NULL; + } +} + +static Scheme_Object *unsafe_fd_to_port(int argc, Scheme_Object *argv[]) +{ + return unsafe_handle_to_port("unsafe-file-descriptor->port", argc, argv, 0); +} + +static Scheme_Object *unsafe_socket_to_port(int argc, Scheme_Object *argv[]) +{ + return unsafe_handle_to_port("unsafe-socket->port", argc, argv, 1); +} + +static Scheme_Object *unsafe_port_to_fd(int argc, Scheme_Object *argv[]) +{ + intptr_t s; + + if (scheme_get_port_file_descriptor(argv[0], &s)) + return scheme_make_integer_value(s); + else { + if (!SCHEME_INPUT_PORTP(argv[0]) && !SCHEME_OUTPUT_PORTP(argv[0])) + scheme_wrong_contract("unsafe-port->file-descriptor", "port?", 0, argc, argv); + return scheme_false; + } +} + +static Scheme_Object *unsafe_port_to_socket(int argc, Scheme_Object *argv[]) +{ + intptr_t s; + + if (scheme_get_port_socket(argv[0], &s)) + return scheme_make_integer_value(s); + else { + if (!SCHEME_INPUT_PORTP(argv[0]) && !SCHEME_OUTPUT_PORTP(argv[0])) + scheme_wrong_contract("unsafe-port->socket", "port?", 0, argc, argv); + return scheme_false; + } +} + +static Scheme_Object *unsafe_handle_to_semaphore(const char *who, int argc, Scheme_Object *argv[], int is_socket) +{ + Scheme_Object *a = argv[1]; + intptr_t s; + int mode; + + if (!scheme_get_int_val(argv[0], &s)) + scheme_wrong_contract(who, "handle-integer?", 0, argc, argv); + + if (!SCHEME_SYMBOLP(a) || SCHEME_SYM_WEIRDP(a)) + mode = -1; + else if (!strcmp(SCHEME_SYM_VAL(a), "read")) + mode = MZFD_CREATE_READ; + else if (!strcmp(SCHEME_SYM_VAL(a), "write")) + mode = MZFD_CREATE_WRITE; + else if (!strcmp(SCHEME_SYM_VAL(a), "check-read")) + mode = MZFD_CHECK_READ; + else if (!strcmp(SCHEME_SYM_VAL(a), "check-write")) + mode = MZFD_CHECK_WRITE; + else if (!strcmp(SCHEME_SYM_VAL(a), "remove")) + mode = MZFD_REMOVE; + else + mode = -1; + + if (mode == -1) + scheme_wrong_contract(who, "semaphore-mode-symbol?", 1, argc, argv); + + a = scheme_fd_to_semaphore(s, mode, is_socket); + return (a ? a : scheme_false); +} + +static Scheme_Object *unsafe_fd_to_semaphore(int argc, Scheme_Object *argv[]) +{ + return unsafe_handle_to_semaphore("unsafe-file-descriptor->semaphore", argc, argv, 0); +} + +static Scheme_Object *unsafe_socket_to_semaphore(int argc, Scheme_Object *argv[]) +{ + return unsafe_handle_to_semaphore("unsafe-socket->semaphore", argc, argv, 1); +} + Scheme_Object *scheme_file_identity(int argc, Scheme_Object *argv[]) { intptr_t fd = 0; diff --git a/racket/src/racket/src/schminc.h b/racket/src/racket/src/schminc.h index 9f9cf9059c..35188331fe 100644 --- a/racket/src/racket/src/schminc.h +++ b/racket/src/racket/src/schminc.h @@ -15,7 +15,7 @@ #define USE_COMPILED_STARTUP 1 #define EXPECTED_PRIM_COUNT 1160 -#define EXPECTED_UNSAFE_COUNT 150 +#define EXPECTED_UNSAFE_COUNT 156 #define EXPECTED_FLFXNUM_COUNT 69 #define EXPECTED_EXTFL_COUNT 45 #define EXPECTED_FUTURES_COUNT 15 diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 580a742fea..b782fb11d6 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -379,6 +379,7 @@ void scheme_init_exn(Scheme_Env *env); void scheme_init_debug(Scheme_Env *env); void scheme_init_thread(Scheme_Env *env); void scheme_init_unsafe_thread(Scheme_Env *env); +void scheme_init_unsafe_port(Scheme_Env *env); void scheme_init_read(Scheme_Env *env); void scheme_init_print(Scheme_Env *env); #ifndef NO_SCHEME_THREADS diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 7d4f05b388..2dabe88403 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.11.0.3" +#define MZSCHEME_VERSION "6.11.0.4" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 11 #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)