867 lines
21 KiB
C
867 lines
21 KiB
C
/*
|
|
* Copyright (c) 2001 by The XFree86 Project, Inc.
|
|
*
|
|
* Permission is hereby granted, free of charge, to any person obtaining a
|
|
* copy of this software and associated documentation files (the "Software"),
|
|
* to deal in the Software without restriction, including without limitation
|
|
* the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
|
* and/or sell copies of the Software, and to permit persons to whom the
|
|
* Software is furnished to do so, subject to the following conditions:
|
|
*
|
|
* The above copyright notice and this permission notice shall be included in
|
|
* all copies or substantial portions of the Software.
|
|
*
|
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
* THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
|
* WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
|
|
* OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
* SOFTWARE.
|
|
*
|
|
* Except as contained in this notice, the name of the XFree86 Project shall
|
|
* not be used in advertising or otherwise to promote the sale, use or other
|
|
* dealings in this Software without prior written authorization from the
|
|
* XFree86 Project.
|
|
*
|
|
* Author: Paulo César Pereira de Andrade
|
|
*/
|
|
|
|
/* $XFree86: xc/programs/xedit/lisp/stream.c,v 1.21tsi Exp $ */
|
|
|
|
#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>
|
|
|
|
/*
|
|
* Initialization
|
|
*/
|
|
#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;
|
|
|
|
/*
|
|
* Implementation
|
|
*/
|
|
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)
|
|
/*
|
|
delete-file filename
|
|
*/
|
|
{
|
|
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)
|
|
/*
|
|
rename-file filename new-name
|
|
*/
|
|
{
|
|
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)
|
|
/*
|
|
streamp object
|
|
*/
|
|
{
|
|
LispObj *object;
|
|
|
|
object = ARGUMENT(0);
|
|
|
|
return (STREAMP(object) ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_InputStreamP(LispBuiltin *builtin)
|
|
/*
|
|
input-stream-p stream
|
|
*/
|
|
{
|
|
LispObj *stream;
|
|
|
|
stream = ARGUMENT(0);
|
|
|
|
CHECK_STREAM(stream);
|
|
|
|
return (stream->data.stream.readable ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_OpenStreamP(LispBuiltin *builtin)
|
|
/*
|
|
open-stream-p stream
|
|
*/
|
|
{
|
|
LispObj *stream;
|
|
|
|
stream = ARGUMENT(0);
|
|
|
|
CHECK_STREAM(stream);
|
|
|
|
return (stream->data.stream.readable || stream->data.stream.writable ?
|
|
T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_OutputStreamP(LispBuiltin *builtin)
|
|
/*
|
|
output-stream-p stream
|
|
*/
|
|
{
|
|
LispObj *stream;
|
|
|
|
stream = ARGUMENT(0);
|
|
|
|
CHECK_STREAM(stream);
|
|
|
|
return (stream->data.stream.writable ? T : NIL);
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_Open(LispBuiltin *builtin)
|
|
/*
|
|
open filename &key direction element-type if-exists if-does-not-exist external-format
|
|
*/
|
|
{
|
|
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) {
|
|
/* just check argument... */
|
|
if (SYMBOLP(element_type) &&
|
|
ATOMID(element_type) == Scharacter)
|
|
; /* do nothing */
|
|
else if (KEYWORDP(element_type) &&
|
|
ATOMID(element_type) == Sdefault)
|
|
; /* do nothing */
|
|
else
|
|
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
|
|
STRFUN(builtin), Sdefault, Scharacter, 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) {
|
|
/* just check argument... */
|
|
if (SYMBOLP(external_format) &&
|
|
ATOMID(external_format) == Scharacter)
|
|
; /* do nothing */
|
|
else if (KEYWORDP(external_format) &&
|
|
ATOMID(external_format) == Sdefault)
|
|
; /* do nothing */
|
|
else
|
|
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
|
|
STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
|
|
}
|
|
|
|
/* string representation of pathname */
|
|
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) {
|
|
/* Add an ending '~' at the end of the backup file */
|
|
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)
|
|
/*
|
|
close stream &key abort
|
|
*/
|
|
{
|
|
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)
|
|
/*
|
|
listen &optional input-stream
|
|
*/
|
|
{
|
|
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)
|
|
/*
|
|
make-string-input-stream string &optional start end
|
|
*/
|
|
{
|
|
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)
|
|
/*
|
|
make-string-output-stream &key element-type
|
|
*/
|
|
{
|
|
LispObj *element_type;
|
|
|
|
element_type = ARGUMENT(0);
|
|
|
|
if (element_type != UNSPEC) {
|
|
/* just check argument... */
|
|
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
|
|
; /* do nothing */
|
|
else if (KEYWORDP(element_type) &&
|
|
ATOMID(element_type) == Sdefault)
|
|
; /* do nothing */
|
|
else
|
|
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
|
|
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
|
|
}
|
|
|
|
return (LSTRINGSTREAM("", STREAM_WRITE, 1));
|
|
}
|
|
|
|
LispObj *
|
|
Lisp_GetOutputStreamString(LispBuiltin *builtin)
|
|
/*
|
|
get-output-stream-string string-output-stream
|
|
*/
|
|
{
|
|
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);
|
|
|
|
/* reset string */
|
|
SSTREAMP(string_output_stream)->output =
|
|
SSTREAMP(string_output_stream)->length =
|
|
SSTREAMP(string_output_stream)->column = 0;
|
|
|
|
return (result);
|
|
}
|
|
|
|
|
|
/* XXX Non standard functions below
|
|
*/
|
|
LispObj *
|
|
Lisp_MakePipe(LispBuiltin *builtin)
|
|
/*
|
|
make-pipe command-line &key :direction :element-type :external-format
|
|
*/
|
|
{
|
|
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) {
|
|
/* just check argument... */
|
|
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
|
|
; /* do nothing */
|
|
else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
|
|
; /* do nothing */
|
|
else
|
|
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
|
|
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
|
|
}
|
|
|
|
if (external_format != UNSPEC) {
|
|
/* just check argument... */
|
|
if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
|
|
; /* do nothing */
|
|
else if (KEYWORDP(external_format) &&
|
|
ATOMID(external_format) == Sdefault)
|
|
; /* do nothing */
|
|
else
|
|
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
|
|
STRFUN(builtin), Sdefault, Scharacter, 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);
|
|
}
|
|
|
|
/* Helper function, primarily for use with the xt module
|
|
*/
|
|
LispObj *
|
|
Lisp_PipeBroken(LispBuiltin *builtin)
|
|
/*
|
|
pipe-broken pipe-stream
|
|
*/
|
|
{
|
|
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);
|
|
}
|
|
|
|
/*
|
|
Helper function, so that it is not required to redirect error output
|
|
*/
|
|
LispObj *
|
|
Lisp_PipeErrorStream(LispBuiltin *builtin)
|
|
/*
|
|
pipe-error-stream pipe-stream
|
|
*/
|
|
{
|
|
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);
|
|
}
|
|
|
|
/*
|
|
Helper function, primarily for use with the xt module
|
|
*/
|
|
LispObj *
|
|
Lisp_PipeInputDescriptor(LispBuiltin *builtin)
|
|
/*
|
|
pipe-input-descriptor pipe-stream
|
|
*/
|
|
{
|
|
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))));
|
|
}
|
|
|
|
/*
|
|
Helper function, primarily for use with the xt module
|
|
*/
|
|
LispObj *
|
|
Lisp_PipeErrorDescriptor(LispBuiltin *builtin)
|
|
/*
|
|
pipe-error-descriptor pipe-stream
|
|
*/
|
|
{
|
|
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))));
|
|
}
|