Commit aad1edbf authored by Marius Gerbershagen's avatar Marius Gerbershagen
Browse files

Merge branch 'file-stream-improvements' into 'develop'

File stream improvements

Closes #511

See merge request embeddable-common-lisp/ecl!245
parents e466823a 7ddb4ada
......@@ -234,9 +234,17 @@ FEreader_error(const char *s, cl_object stream, int narg, ...)
void
FEcannot_open(cl_object fn)
{
cl_error(3, @'file-error', @':pathname', fn);
FEcannot_open(cl_object file)
{
cl_object c_error = _ecl_strerror(errno);
si_signal_simple_error
(6, @'file-error', /* condition */
ECL_NIL, /* continuable */
ecl_make_constant_base_string("Cannot open ~S.~%C library error: ~A",-1), /* format */
cl_list(2, file, c_error), /* format args */
@':pathname', /* file-error options */
file);
_ecl_unexpected_return();
}
void
......
......@@ -2615,17 +2615,6 @@ safe_close(int f)
return output;
}
static FILE *
safe_fopen(const char *filename, const char *mode)
{
const cl_env_ptr the_env = ecl_process_env();
FILE *output;
ecl_disable_interrupts_env(the_env);
output = fopen(filename, mode);
ecl_enable_interrupts_env(the_env);
return output;
}
static FILE *
safe_fdopen(int fildes, const char *mode)
{
......@@ -5250,14 +5239,30 @@ FEinvalid_option(cl_object option, cl_object value)
FEerror("Invalid value op option ~A: ~A", 2, option, value);
}
static int
smmode_to_open_flag(enum ecl_smmode smm)
{
switch (smm) {
case ecl_smm_probe:
case ecl_smm_input:
return O_RDONLY;
case ecl_smm_output:
return O_WRONLY;
case ecl_smm_io:
return O_RDWR;
default:
FEerror("Illegal stream mode ~S", 1, ecl_make_fixnum(smm));
}
}
cl_object
ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
cl_object if_does_not_exist, cl_fixnum byte_size,
int flags, cl_object external_format)
{
cl_object output, file_kind;
int fd;
bool appending = 0, exists;
cl_object output;
int fd, open_flags = smmode_to_open_flag(smm) | O_BINARY;
bool appending = 0;
#if defined(ECL_MS_WINDOWS_HOST)
ecl_mode_t mode = _S_IREAD | _S_IWRITE;
#else
......@@ -5267,91 +5272,93 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
remembers the original pathname FN. -- jd 2020-03-27 */
cl_object filename = si_coerce_to_filename(fn);
char *fname = (char*)filename->base_string.self;
file_kind = si_file_kind(filename, ECL_T);
exists = file_kind != ECL_NIL;
if (!exists) {
if (if_does_not_exist == ECL_NIL) return ECL_NIL;
if (if_does_not_exist == @':error') FEcannot_open(fn);
if (if_does_not_exist != @':create')
FEinvalid_option(@':if-does-not-exist', if_does_not_exist);
fd = safe_open(fname, O_WRONLY|O_CREAT, mode);
unlikely_if (fd < 0) FEcannot_open(fn);
safe_close(fd);
fd = -1;
if (if_does_not_exist == @':create') {
open_flags |= O_CREAT;
if ((smm == ecl_smm_output || smm == ecl_smm_io) &&
(if_exists == ECL_NIL || if_exists == @':error' || if_exists == @':rename')) {
open_flags |= O_EXCL;
}
} else if (if_does_not_exist != ECL_NIL && if_does_not_exist != @':error') {
FEinvalid_option(@':if-does-not-exist', if_does_not_exist);
}
if (if_exists == @':rename_and_delete' ||
if_exists == @':new_version' ||
if_exists == @':supersede' ||
if_exists == @':truncate') {
if (smm == ecl_smm_output || smm == ecl_smm_io) {
open_flags |= O_TRUNC;
}
} else if (if_exists == @':append') {
if (smm == ecl_smm_output || smm == ecl_smm_io) {
appending = 1;
}
} else if (if_exists != ECL_NIL &&
if_exists != @':error' &&
if_exists != @':rename' &&
if_exists != @':overwrite') {
FEinvalid_option(@':if-exists', if_exists);
}
switch (smm) {
case ecl_smm_probe:
output = ecl_make_file_stream_from_fd(fn, -1, smm, byte_size, flags, external_format);
generic_close(output);
return output;
case ecl_smm_input:
fd = safe_open(fname, O_RDONLY|O_NONBLOCK, mode);
unlikely_if (fd < 0) FEcannot_open(fn);
break;
case ecl_smm_output:
/* For output we could have used O_WRONLY, but this doesn't matter because
we fopen with OPEN_RW later anyway. stream opts enforce things. */
case ecl_smm_io: {
if (exists) {
if (if_exists == ECL_NIL) return ECL_NIL;
if (if_exists == @':error') FEcannot_open(fn);
if (if_exists == @':rename') {
fd = ecl_backup_open(fname, O_RDWR|O_CREAT, mode);
unlikely_if (fd < 0) FEcannot_open(fn);
} else if (if_exists == @':rename_and_delete' ||
if_exists == @':new_version' ||
if_exists == @':supersede' ||
if_exists == @':truncate') {
fd = safe_open(fname, O_RDWR|O_TRUNC, mode);
unlikely_if (fd < 0) FEcannot_open(fn);
} else if (if_exists == @':overwrite' || if_exists == @':append') {
fd = safe_open(fname, O_RDWR, mode);
if (flags & ECL_STREAM_CLOSE_ON_EXEC) {
open_flags |= O_CLOEXEC;
}
if (flags & ECL_STREAM_NONBLOCK) {
open_flags |= O_NONBLOCK;
}
fd = safe_open(fname, open_flags, mode);
if (fd < 0) {
if (errno == ENOENT && if_does_not_exist == ECL_NIL) {
return ECL_NIL;
} else if (errno == EEXIST) {
if (if_exists == ECL_NIL) {
safe_close(fd);
return ECL_NIL;
} else if (if_exists == @':error') {
safe_close(fd);
FEcannot_open(fn);
} else if (if_exists == @':rename') {
safe_close(fd);
fd = ecl_backup_open(fname, smmode_to_open_flag(smm)|O_CREAT, mode);
unlikely_if (fd < 0) FEcannot_open(fn);
appending = (if_exists == @':append');
} else {
FEinvalid_option(@':if-exists', if_exists);
}
} else {
FEcannot_open(fn);
}
break;
}
default:
FEerror("Illegal stream mode ~S", 1, ecl_make_fixnum(smm));
if (smm == ecl_smm_probe) {
safe_close(fd);
output = ecl_make_file_stream_from_fd(fn, -1, smm, byte_size, flags, external_format);
generic_close(output);
return output;
}
if (flags & ECL_STREAM_C_STREAM) {
FILE *fp = 0;
/* We do not use fdopen() because Windows seems to have problems with the
* resulting streams. Furthermore, even for output we open with w+ because
* we do not want to overwrite the file. */
switch (smm) {
case ecl_smm_probe:
/* never happens (returns earlier) */
case ecl_smm_input:
if (file_kind == @':fifo') {
fp = safe_fdopen(fd, OPEN_R);
} else {
if (fd >= 0)
safe_close(fd);
fp = safe_fopen(fname, OPEN_R);
}
fp = safe_fdopen(fd, OPEN_R);
break;
case ecl_smm_output:
fp = safe_fdopen(fd, OPEN_W);
break;
case ecl_smm_io:
if (file_kind == @':fifo') {
fp = safe_fdopen(fd, OPEN_RW);
} else {
if (fd >= 0)
safe_close(fd);
fp = safe_fopen(fname, OPEN_RW);
}
fp = safe_fdopen(fd, OPEN_RW);
break;
default:;
/* never reached (errors earlier) */
}
if (fp == NULL) {
FEcannot_open(fn);
}
output = ecl_make_stream_from_FILE(fn, fp, smm, byte_size, flags, external_format);
si_set_buffering_mode(output, byte_size? @':full' : @':line');
} else {
output = ecl_make_file_stream_from_fd(fn, fd, smm, byte_size, flags, external_format);
}
output->stream.flags |= ECL_STREAM_MIGHT_SEEK;
si_set_finalizer(output, ECL_T);
/* Set file pointer to the correct position */
......@@ -5366,6 +5373,8 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
(if_does_not_exist ECL_NIL idnesp)
(external_format @':default')
(cstream ECL_T)
(close_on_exec ECL_T)
(nonblock ECL_NIL)
&aux strm)
enum ecl_smmode smm;
int flags = 0;
......@@ -5413,6 +5422,12 @@ ecl_open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
if (!Null(cstream)) {
flags |= ECL_STREAM_C_STREAM;
}
if (!Null(close_on_exec)) {
flags |= ECL_STREAM_CLOSE_ON_EXEC;
}
if (!Null(nonblock)) {
flags |= ECL_STREAM_NONBLOCK;
}
strm = ecl_open_stream(filename, smm, if_exists, if_does_not_exist,
byte_size, flags, external_format);
@(return strm);
......@@ -5703,7 +5718,7 @@ file_libc_error(cl_object error_type, cl_object stream,
rest = cl_grab_rest_args(args);
ecl_va_end(args);
si_signal_simple_error(4, (cl_object)(cl_symbols + ecl_fixnum(error_type)), Cnil,
si_signal_simple_error(4, (cl_object)(cl_symbols + ecl_fixnum(error_type)), ECL_NIL,
ecl_make_constant_base_string("~?~%C library explanation: ~A.",-1),
cl_list(3, ecl_make_constant_base_string(msg,-1), rest,
error));
......
......@@ -1359,6 +1359,7 @@ cl_symbols[] = {
{KEY_ "CATCH" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "CASE" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "CIRCLE" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "CLOSE-ON-EXEC" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "COMPILE-TOPLEVEL" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "COMMON" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "CONC-NAME" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
......@@ -1435,6 +1436,7 @@ cl_symbols[] = {
{KEY_ "NEW-VERSION" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "NEWEST" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "NICKNAMES" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "NONBLOCK" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "OBJECT" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "OFFSET" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
{KEY_ "OPERATION" ECL_FUN(NULL, NULL, -1) ECL_VAR(KEYWORD, OBJNULL)},
......
......@@ -293,11 +293,11 @@ Controls escaping of the arguments passed to @code{CreateProcess}.
@subsection FIFO files (named pipes)
Named pipe (known as fifo) may be created on UNIX with a shell command
mkfifo. ECL opens such files in non-blocking
mode. @coderef{ext:file-kind} will return for such file
@code{:fifo}. Since it is impossible to guess how many characters are
available in this special file @code{file-length} function will return
NIL.
mkfifo. They can be opened in non-blocking mode by using @code{:nonblock
t} option for @coderef{open}. @coderef{ext:file-kind} will return for
such file @code{:fifo}. Since it is impossible to guess how many
characters are available in this special file @code{file-length}
function will return @code{nil}.
@node Operating System Interface Reference
@subsection Operating System Interface Reference
......
......@@ -108,59 +108,23 @@ and the table of known symbols is shown below. Note how some symbols (@code{:cr}
@node Streams - Dictionary
@subsection Dictionary
@subsubsection Sequence Streams
@lspdef ext:sequence-stream
@deftp {System Class} ext:sequence-stream
@paragraph Class Precedence List
@coderef{ext:sequence-stream}, @code{stream}, @code{t}
@paragraph Description
Sequence streams work similar to string streams for vectors. The
supplied vectors that the streams read from or write to must have a
byte sized element type, i.e. @code{(signed-byte 8)},
@code{(unsigned-byte 8)} or @code{base-char}.
The semantics depend on the vector element type and the external
format of the stream. If no external format is supplied and the
element type is an integer type, the stream is a binary stream and
accepts only integers of the same type as the element type of the
vector. Otherwise, the stream accepts both characters and integers and
converts them using the given external format. If the element type is
@code{base-char}, the elements of the vectors are treated as bytes.
This means that writing a character may use multiple elements of the
vector, whose @code{char-code}s will be equal to the values of the
bytes comprising the character in the given external format.
@end deftp
@subsubsection File Stream Extensions
@lspdef ext:make-sequence-input-stream
@defun ext:make-sequence-input-stream vector &key (start 0) (end nil) (external-format nil)
Create a sequence input stream with the subsequence bounded by
@var{start} and @var{end} of the given vector.
@end defun
@lspdef ext:make-sequence-output-stream
@defun ext:make-sequence-output-stream vector &key (external-format nil)
Create a sequence output stream.
@lspdef open
@defun open filespec &key direction element-type if-exists if-does-not-exist external-format close-on-exec nonblock
Additional options for @clhs{f_open.htm,open} include:
@table @code
@item :close-on-exec
Child processes don't inherit a copy of this stream: new processes
created by @code{fork} and @code{exec} (for example by calling
@coderef{ext:run-program}) close the stream after calling @code{exec}.
Defaults to @code{t}.
@item :nonblock
Open fifos or device files in nonblocking mode. Defaults to @code{nil}.
@end table
These options are ignored on operating systems which do not support them.
@end defun
@exindex Using sequence streams
Example:
Using sequence streams to convert to a UTF8 encoded base string
@lisp
CL-USER> (defvar *output* (make-array 20 :element-type 'base-char :adjustable t :fill-pointer 0))
*OUTPUT*
CL-USER> (defvar *stream* (ext:make-sequence-output-stream *output* :external-format :utf-8))
*STREAM*
CL-USER> (write-string "Spätzle mit Soß'" *stream*)
"Spätzle mit Soß'"
CL-USER> *output*
"Spätzle mit SoÃ\237'"
@end lisp
@subsubsection File Stream Extensions
@lspdef ext:set-buffering-mode
@defun ext:set-buffering-mode stream mode
Control the buffering mode of a stream
......@@ -303,6 +267,56 @@ that the error can be ignored or the octets can be replaced with a
character.
@end defun
@subsubsection Sequence Streams
@lspdef ext:sequence-stream
@deftp {System Class} ext:sequence-stream
@paragraph Class Precedence List
@coderef{ext:sequence-stream}, @code{stream}, @code{t}
@paragraph Description
Sequence streams work similar to string streams for vectors. The
supplied vectors that the streams read from or write to must have a
byte sized element type, i.e. @code{(signed-byte 8)},
@code{(unsigned-byte 8)} or @code{base-char}.
The semantics depend on the vector element type and the external
format of the stream. If no external format is supplied and the
element type is an integer type, the stream is a binary stream and
accepts only integers of the same type as the element type of the
vector. Otherwise, the stream accepts both characters and integers and
converts them using the given external format. If the element type is
@code{base-char}, the elements of the vectors are treated as bytes.
This means that writing a character may use multiple elements of the
vector, whose @code{char-code}s will be equal to the values of the
bytes comprising the character in the given external format.
@end deftp
@lspdef ext:make-sequence-input-stream
@defun ext:make-sequence-input-stream vector &key (start 0) (end nil) (external-format nil)
Create a sequence input stream with the subsequence bounded by
@var{start} and @var{end} of the given vector.
@end defun
@lspdef ext:make-sequence-output-stream
@defun ext:make-sequence-output-stream vector &key (external-format nil)
Create a sequence output stream.
@end defun
@exindex Using sequence streams
Example:
Using sequence streams to convert to a UTF8 encoded base string
@lisp
CL-USER> (defvar *output* (make-array 20 :element-type 'base-char :adjustable t :fill-pointer 0))
*OUTPUT*
CL-USER> (defvar *stream* (ext:make-sequence-output-stream *output* :external-format :utf-8))
*STREAM*
CL-USER> (write-string "Spätzle mit Soß'" *stream*)
"Spätzle mit Soß'"
CL-USER> *output*
"Spätzle mit SoÃ\237'"
@end lisp
@node Streams - C Reference
@subsection C Reference
......
......@@ -234,9 +234,16 @@ extern enum ecl_ffi_tag ecl_foreign_type_code(cl_object type);
#define OPEN_RA "a+b"
/* Windows does not have this flag (POSIX thing) */
#ifndef O_CLOEXEC
#define O_CLOEXEC 0
#endif
#ifndef O_NONBLOCK
#define O_NONBLOCK 0
#endif
/* Windows needs to be told explicitely to open files in binary mode */
#ifndef O_BINARY
#define O_BINARY 0
#endif
#define ECL_FILE_STREAM_P(strm) \
(ECL_ANSI_STREAM_P(strm) && (strm)->stream.mode < ecl_smm_synonym)
......
......@@ -634,7 +634,9 @@ enum {
ECL_STREAM_LITTLE_ENDIAN = 128,
ECL_STREAM_C_STREAM = 256,
ECL_STREAM_MIGHT_SEEK = 512,
ECL_STREAM_CLOSE_COMPONENTS = 1024
ECL_STREAM_CLOSE_COMPONENTS = 1024,
ECL_STREAM_CLOSE_ON_EXEC = 2048,
ECL_STREAM_NONBLOCK = 4096
};
/* buffer points to an array of bytes ending at buffer_end. Decode one
......
......@@ -256,42 +256,29 @@
;;; Date: 2018-05-08
;;; Description:
;;;
;;; Better handling of fifos. This test will most likely fail on Windows (this
;;; is not confirmed yet) because it does not support non-blocking
;;; operations.
;;;
;;; When we figure out what would be correct semantics for Windows this test
;;; should be disabled for that platform and a separate test case ought to be
;;; created. It is possible that it won't fail (because cygwin will handle it
;;; gracefully and/or WinAPI does not support file-pipes).
;;; Better handling of fifos.
;;;
;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/242
#-windows
(test mix.0016.fifo-tests
(ext:run-program "mkfifo" '("my-fifo") :output t)
;; 1) reader (first) and writer (inside)
(with-open-file (stream "my-fifo")
(with-open-file (stream "my-fifo" :nonblock t)
(is (null (file-length stream)))
(is (null (listen stream)))
(is (eql :foo (read-line stream nil :foo)))
(is (eql :fifo (ext:file-kind stream nil)))
(with-open-file (stream2 "my-fifo" :direction :output)
;; Even for output it should not block on Linux.
(with-open-file (stream2 "my-fifo" :direction :output :nonblock t)
;; Even for output it should not block on Unix.
(finishes (write-line "foobar" stream2)))
(is (equal "foobar" (read-line stream nil :foo))))
;; 2) writer (first) and reader (second)
(with-open-file (stream "my-fifo" :direction :output)
(finishes (write-line "foobar" stream)))
(with-open-file (stream "my-fifo" :direction :input)
;; there is nobody on the other side, data is lost
(is (equal :foo (read-line stream nil :foo))))
;; 2) writer (first) and reader (second)
(signals file-error (open "my-fifo" :direction :output :nonblock t))
(with-open-file (stream "my-fifo" :direction :input :nonblock t)
(is (eql :foo (read-line stream nil :foo))))
;; 3) writer (first) and reader (inside)
(with-open-file (stream "my-fifo" :direction :output)
(finishes (write-line "foobar" stream))
(with-open-file (stream2 "my-fifo" :direction :input)
;; Even for output it should not block on Linux.
(is (equal "foobar" (read-line stream2 nil :foo)))))
;; clean up
(ext:run-program "rm" '("-rf" "my-fifo") :output t))
(delete-file "my-fifo"))
;;; Date: 2018-12-02
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment