#include "lisp/read.h"
#include "lisp/stream.h"
#include "lisp/pathname.h"
#include "lisp/write.h"
#include "lisp/private.h"
#include <errno.h>
#include <fcntl.h>
#include <signal.h>
#include <string.h>
#include <sys/wait.h>
#define DIR_PROBE 0
#define DIR_INPUT 1
#define DIR_OUTPUT 2
#define DIR_IO 3
#define EXT_NIL 0
#define EXT_ERROR 1
#define EXT_NEW_VERSION 2
#define EXT_RENAME 3
#define EXT_RENAME_DELETE 4
#define EXT_OVERWRITE 5
#define EXT_APPEND 6
#define EXT_SUPERSEDE 7
#define NOEXT_NIL 0
#define NOEXT_ERROR 1
#define NOEXT_CREATE 2
#define NOEXT_NOTHING 3
extern char **environ;
LispObj *Oopen, *Oclose, *Otruename;
LispObj *Kif_does_not_exist, *Kprobe, *Kinput, *Koutput, *Kio,
*Knew_version, *Krename, *Krename_and_delete, *Koverwrite,
*Kappend, *Ksupersede, *Kcreate;
void
LispStreamInit(void)
{
Oopen = STATIC_ATOM("OPEN");
Oclose = STATIC_ATOM("CLOSE");
Otruename = STATIC_ATOM("TRUENAME");
Kif_does_not_exist = KEYWORD("IF-DOES-NOT-EXIST");
Kprobe = KEYWORD("PROBE");
Kinput = KEYWORD("INPUT");
Koutput = KEYWORD("OUTPUT");
Kio = KEYWORD("IO");
Knew_version = KEYWORD("NEW-VERSION");
Krename = KEYWORD("RENAME");
Krename_and_delete = KEYWORD("RENAME-AND-DELETE");
Koverwrite = KEYWORD("OVERWRITE");
Kappend = KEYWORD("APPEND");
Ksupersede = KEYWORD("SUPERSEDE");
Kcreate = KEYWORD("CREATE");
}
LispObj *
Lisp_DeleteFile(LispBuiltin *builtin)
{
GC_ENTER();
LispObj *filename;
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
GC_LEAVE();
return (LispUnlink(THESTR(CAR(filename->data.pathname))) ? NIL : T);
}
LispObj *
Lisp_RenameFile(LispBuiltin *builtin)
{
int code;
GC_ENTER();
char *from, *to;
LispObj *old_truename, *new_truename;
LispObj *filename, *new_name;
new_name = ARGUMENT(1);
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
old_truename = APPLY1(Otruename, filename);
GC_PROTECT(old_truename);
if (STRINGP(new_name)) {
new_name = APPLY3(Oparse_namestring, new_name, NIL, filename);
GC_PROTECT(new_name);
}
else {
CHECK_PATHNAME(new_name);
}
from = THESTR(CAR(filename->data.pathname));
to = THESTR(CAR(new_name->data.pathname));
code = LispRename(from, to);
if (code)
LispDestroy("%s: rename(%s, %s): %s",
STRFUN(builtin), from, to, strerror(errno));
GC_LEAVE();
new_truename = APPLY1(Otruename, new_name);
RETURN_COUNT = 2;
RETURN(0) = old_truename;
RETURN(1) = new_truename;
return (new_name);
}
LispObj *
Lisp_Streamp(LispBuiltin *builtin)
{
LispObj *object;
object = ARGUMENT(0);
return (STREAMP(object) ? T : NIL);
}
LispObj *
Lisp_InputStreamP(LispBuiltin *builtin)
{
LispObj *stream;
stream = ARGUMENT(0);
CHECK_STREAM(stream);
return (stream->data.stream.readable ? T : NIL);
}
LispObj *
Lisp_OpenStreamP(LispBuiltin *builtin)
{
LispObj *stream;
stream = ARGUMENT(0);
CHECK_STREAM(stream);
return (stream->data.stream.readable || stream->data.stream.writable ?
T : NIL);
}
LispObj *
Lisp_OutputStreamP(LispBuiltin *builtin)
{
LispObj *stream;
stream = ARGUMENT(0);
CHECK_STREAM(stream);
return (stream->data.stream.writable ? T : NIL);
}
LispObj *
Lisp_Open(LispBuiltin *builtin)
{
GC_ENTER();
char *string;
LispObj *stream = NIL;
int mode, flags, direction, exist, noexist, file_exist;
LispFile *file;
LispObj *filename, *odirection, *element_type, *if_exists,
*if_does_not_exist, *external_format;
external_format = ARGUMENT(5);
if_does_not_exist = ARGUMENT(4);
if_exists = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
if (SYMBOLP(element_type) &&
ATOMID(element_type) == Scharacter)
;
else if (KEYWORDP(element_type) &&
ATOMID(element_type) == Sdefault)
;
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
}
if (if_exists != UNSPEC) {
exist = -1;
if (if_exists == NIL)
exist = EXT_NIL;
else if (KEYWORDP(if_exists)) {
if (if_exists == Kerror)
exist = EXT_ERROR;
else if (if_exists == Knew_version)
exist = EXT_NEW_VERSION;
else if (if_exists == Krename)
exist = EXT_RENAME;
else if (if_exists == Krename_and_delete)
exist = EXT_RENAME_DELETE;
else if (if_exists == Koverwrite)
exist = EXT_OVERWRITE;
else if (if_exists == Kappend)
exist = EXT_APPEND;
else if (if_exists == Ksupersede)
exist = EXT_SUPERSEDE;
}
if (exist == -1)
LispDestroy("%s: bad :IF-EXISTS %s",
STRFUN(builtin), STROBJ(if_exists));
}
else
exist = EXT_ERROR;
if (if_does_not_exist != UNSPEC) {
noexist = -1;
if (if_does_not_exist == NIL)
noexist = NOEXT_NIL;
if (KEYWORDP(if_does_not_exist)) {
if (if_does_not_exist == Kerror)
noexist = NOEXT_ERROR;
else if (if_does_not_exist == Kcreate)
noexist = NOEXT_CREATE;
}
if (noexist == -1)
LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s",
STRFUN(builtin), STROBJ(if_does_not_exist));
}
else
noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR;
if (external_format != UNSPEC) {
if (SYMBOLP(external_format) &&
ATOMID(external_format) == Scharacter)
;
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
;
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format));
}
string = THESTR(CAR(filename->data.pathname));
mode = 0;
file_exist = access(string, F_OK) == 0;
if (file_exist) {
if (exist == EXT_NIL) {
GC_LEAVE();
return (NIL);
}
}
else {
if (noexist == NOEXT_NIL) {
GC_LEAVE();
return (NIL);
}
if (noexist == NOEXT_ERROR)
LispDestroy("%s: file %s does not exist",
STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
else if (noexist == NOEXT_CREATE) {
LispFile *tmp = LispFopen(string, FILE_WRITE);
if (tmp)
LispFclose(tmp);
else
LispDestroy("%s: cannot create file %s",
STRFUN(builtin),
STROBJ(CAR(filename->data.quote)));
}
}
if (direction == DIR_OUTPUT || direction == DIR_IO) {
if (file_exist) {
if (exist == EXT_ERROR)
LispDestroy("%s: file %s already exists",
STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
if (exist == EXT_RENAME) {
char tmp[PATH_MAX + 1];
strcpy(tmp, string);
if (strlen(tmp) + 1 > PATH_MAX)
LispDestroy("%s: backup name for %s too long",
STRFUN(builtin),
STROBJ(CAR(filename->data.quote)));
strcat(tmp, "~");
if (rename(string, tmp))
LispDestroy("%s: rename: %s",
STRFUN(builtin), strerror(errno));
mode |= FILE_WRITE;
}
else if (exist == EXT_OVERWRITE)
mode |= FILE_WRITE;
else if (exist == EXT_APPEND)
mode |= FILE_APPEND;
}
else
mode |= FILE_WRITE;
if (direction == DIR_IO)
mode |= FILE_IO;
}
else
mode |= FILE_READ;
file = LispFopen(string, mode);
if (file == NULL)
LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno));
flags = 0;
if (direction == DIR_PROBE) {
LispFclose(file);
file = NULL;
}
else {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = FILESTREAM(file, filename, flags);
GC_LEAVE();
return (stream);
}
LispObj *
Lisp_Close(LispBuiltin *builtin)
{
LispObj *stream, *oabort;
oabort = ARGUMENT(1);
stream = ARGUMENT(0);
CHECK_STREAM(stream);
if (stream->data.stream.readable || stream->data.stream.writable) {
stream->data.stream.readable = stream->data.stream.writable = 0;
if (stream->data.stream.type == LispStreamFile) {
LispFclose(stream->data.stream.source.file);
stream->data.stream.source.file = NULL;
}
else if (stream->data.stream.type == LispStreamPipe) {
if (IPSTREAMP(stream)) {
LispFclose(IPSTREAMP(stream));
IPSTREAMP(stream) = NULL;
}
if (OPSTREAMP(stream)) {
LispFclose(OPSTREAMP(stream));
OPSTREAMP(stream) = NULL;
}
if (EPSTREAMP(stream)) {
LispFclose(EPSTREAMP(stream));
EPSTREAMP(stream) = NULL;
}
if (PIDPSTREAMP(stream) > 0) {
kill(PIDPSTREAMP(stream),
oabort == UNSPEC || oabort == NIL ? SIGTERM : SIGKILL);
waitpid(PIDPSTREAMP(stream), NULL, 0);
}
}
return (T);
}
return (NIL);
}
LispObj *
Lisp_Listen(LispBuiltin *builtin)
{
LispFile *file = NULL;
LispObj *result = NIL;
LispObj *stream;
stream = ARGUMENT(0);
if (stream == UNSPEC)
stream = NIL;
else if (stream != NIL) {
CHECK_STREAM(stream);
}
else
stream = lisp__data.standard_input;
if (stream->data.stream.readable) {
switch (stream->data.stream.type) {
case LispStreamString:
if (SSTREAMP(stream)->input < SSTREAMP(stream)->length)
result = T;
break;
case LispStreamFile:
file = FSTREAMP(stream);
break;
case LispStreamStandard:
file = FSTREAMP(stream);
break;
case LispStreamPipe:
file = IPSTREAMP(stream);
break;
}
if (file != NULL) {
if (file->available || file->offset < file->length)
result = T;
else {
unsigned char c;
if (!file->nonblock) {
if (fcntl(file->descriptor, F_SETFL, O_NONBLOCK) < 0)
LispDestroy("%s: fcntl: %s",
STRFUN(builtin), strerror(errno));
file->nonblock = 1;
}
if (read(file->descriptor, &c, 1) == 1) {
LispFungetc(file, c);
result = T;
}
}
}
}
return (result);
}
LispObj *
Lisp_MakeStringInputStream(LispBuiltin *builtin)
{
char *string;
long start, end, length;
LispObj *ostring, *ostart, *oend, *result;
oend = ARGUMENT(2);
ostart = ARGUMENT(1);
ostring = ARGUMENT(0);
start = end = 0;
CHECK_STRING(ostring);
LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
&start, &end, &length);
string = THESTR(ostring);
if (end - start != length)
length = end - start;
result = LSTRINGSTREAM(string + start, STREAM_READ, length);
return (result);
}
LispObj *
Lisp_MakeStringOutputStream(LispBuiltin *builtin)
{
LispObj *element_type;
element_type = ARGUMENT(0);
if (element_type != UNSPEC) {
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
;
else if (KEYWORDP(element_type) &&
ATOMID(element_type) == Sdefault)
;
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
}
return (LSTRINGSTREAM("", STREAM_WRITE, 1));
}
LispObj *
Lisp_GetOutputStreamString(LispBuiltin *builtin)
{
int length;
char *string;
LispObj *string_output_stream, *result;
string_output_stream = ARGUMENT(0);
if (!STREAMP(string_output_stream) ||
string_output_stream->data.stream.type != LispStreamString ||
string_output_stream->data.stream.readable ||
!string_output_stream->data.stream.writable)
LispDestroy("%s: %s is not an output string stream",
STRFUN(builtin), STROBJ(string_output_stream));
string = LispGetSstring(SSTREAMP(string_output_stream), &length);
result = LSTRING(string, length);
SSTREAMP(string_output_stream)->output =
SSTREAMP(string_output_stream)->length =
SSTREAMP(string_output_stream)->column = 0;
return (result);
}
LispObj *
Lisp_MakePipe(LispBuiltin *builtin)
{
char *string;
LispObj *stream = NIL;
int flags, direction;
LispFile *error_file;
LispPipe *program;
int ifd[2];
int ofd[2];
int efd[2];
char *argv[4];
LispObj *command_line, *odirection, *element_type, *external_format;
external_format = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
command_line = ARGUMENT(0);
if (PATHNAMEP(command_line))
command_line = CAR(command_line->data.quote);
else if (!STRINGP(command_line))
LispDestroy("%s: %s is a bad pathname",
STRFUN(builtin), STROBJ(command_line));
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
;
else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
;
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
}
if (external_format != UNSPEC) {
if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
;
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
;
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format));
}
string = THESTR(command_line);
program = LispMalloc(sizeof(LispPipe));
if (direction != DIR_PROBE) {
argv[0] = "sh";
argv[1] = "-c";
argv[2] = string;
argv[3] = NULL;
pipe(ifd);
pipe(ofd);
pipe(efd);
if ((program->pid = fork()) == 0) {
close(0);
close(1);
close(2);
dup2(ofd[0], 0);
dup2(ifd[1], 1);
dup2(efd[1], 2);
close(ifd[0]);
close(ifd[1]);
close(ofd[0]);
close(ofd[1]);
close(efd[0]);
close(efd[1]);
execve("/bin/sh", argv, environ);
exit(-1);
}
else if (program->pid < 0)
LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
close(ifd[1]);
program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
close(ofd[0]);
error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
close(efd[1]);
}
else {
program->pid = -1;
program->input = program->output = error_file = NULL;
}
flags = direction == DIR_PROBE ? 0 : STREAM_READ;
program->errorp = FILESTREAM(error_file, command_line, flags);
flags = 0;
if (direction != DIR_PROBE) {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = PIPESTREAM(program, command_line, flags);
LispMused(program);
return (stream);
}
LispObj *
Lisp_PipeBroken(LispBuiltin *builtin)
{
int pid, status, retval;
LispObj *result = NIL;
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
if ((pid = PIDPSTREAMP(pipe_stream)) > 0) {
retval = waitpid(pid, &status, WNOHANG | WUNTRACED);
if (retval == pid || (retval == -1 && errno == ECHILD))
result = T;
}
return (result);
}
LispObj *
Lisp_PipeErrorStream(LispBuiltin *builtin)
{
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
return (pipe_stream->data.stream.source.program->errorp);
}
LispObj *
Lisp_PipeInputDescriptor(LispBuiltin *builtin)
{
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
if (!IPSTREAMP(pipe_stream))
LispDestroy("%s: pipe %s is unreadable",
STRFUN(builtin), STROBJ(pipe_stream));
return (INTEGER(LispFileno(IPSTREAMP(pipe_stream))));
}
LispObj *
Lisp_PipeErrorDescriptor(LispBuiltin *builtin)
{
LispObj *pipe_stream;
pipe_stream = ARGUMENT(0);
if (!STREAMP(pipe_stream) ||
pipe_stream->data.stream.type != LispStreamPipe)
LispDestroy("%s: %s is not a pipe stream",
STRFUN(builtin), STROBJ(pipe_stream));
if (!EPSTREAMP(pipe_stream))
LispDestroy("%s: pipe %s is closed",
STRFUN(builtin), STROBJ(pipe_stream));
return (INTEGER(LispFileno(EPSTREAMP(pipe_stream))));
}