/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,1998 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,87,88,93,94,95,96,97,98,1999 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <unistd.h>
#endif
-#ifdef STDC_HEADERS
-#include <stdlib.h>
-#endif
-
#if !defined (S_ISLNK) && defined (S_IFLNK)
# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
#endif
static Lisp_Object Vinhibit_file_name_operation;
Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
-
+Lisp_Object Qexcl;
Lisp_Object Qfile_name_history;
Lisp_Object Qcar_less_than_car;
Lisp_Object data;
{
Lisp_Object errstring;
+ int errorno = errno;
- errstring = build_string (strerror (errno));
-
- /* System error messages are capitalized. Downcase the initial
- unless it is followed by a slash. */
- if (XSTRING (errstring)->data[1] != '/')
- XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+ synchronize_messages_locale ();
+ errstring = code_convert_string_norecord (build_string (strerror (errorno)),
+ Vlocale_coding_system, 0);
while (1)
- Fsignal (Qfile_error,
- Fcons (build_string (string), Fcons (errstring, data)));
+ switch (errorno)
+ {
+ case EEXIST:
+ Fsignal (Qfile_already_exists, Fcons (errstring, data));
+ break;
+ default:
+ /* System error messages are capitalized. Downcase the initial
+ unless it is followed by a slash. */
+ if (XSTRING (errstring)->data[1] != '/')
+ XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+
+ Fsignal (Qfile_error,
+ Fcons (build_string (string), Fcons (errstring, data)));
+ }
}
Lisp_Object
close_file_unwind (fd)
Lisp_Object fd;
{
- close (XFASTINT (fd));
+ emacs_close (XFASTINT (fd));
return Qnil;
}
inhibited_handlers = Qnil;
for (chain = Vfile_name_handler_alist; CONSP (chain);
- chain = XCONS (chain)->cdr)
+ chain = XCDR (chain))
{
Lisp_Object elt;
- elt = XCONS (chain)->car;
+ elt = XCAR (chain);
if (CONSP (elt))
{
Lisp_Object string;
- string = XCONS (elt)->car;
+ string = XCAR (elt);
if (STRINGP (string) && fast_string_match (string, filename) >= 0)
{
Lisp_Object handler, tem;
- handler = XCONS (elt)->cdr;
+ handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
return handler;
\n\
In addition, this function makes an attempt to choose a name\n\
which has no existing file. To make this work,\n\
-PREFIX should be an absolute file name.")
+PREFIX should be an absolute file name.\n\
+\n\
+There is a race condition between calling `make-temp-name' and creating the\n\
+file which opens all kinds of security holes. For that reason, you should\n\
+probably use `make-temp-file' instead.")
(prefix)
Lisp_Object prefix;
{
else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
out_st.st_mode = 0;
- ifd = open (XSTRING (encoded_file)->data, O_RDONLY);
+ ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
immediate_quit = 1;
QUIT;
- while ((n = read (ifd, buf, sizeof buf)) > 0)
- if (write (ofd, buf, n) != n)
+ while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
+ if (emacs_write (ofd, buf, n) != n)
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
/* Closing the output clobbers the file times on some systems. */
- if (close (ofd) < 0)
+ if (emacs_close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
if (input_file_statable_p)
#endif /* MSDOS */
}
- close (ifd);
+ emacs_close (ifd);
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = open (XSTRING (absname)->data, flags);
+ desc = emacs_open (XSTRING (absname)->data, flags, 0);
if (desc < 0)
return Qnil;
- close (desc);
+ emacs_close (desc);
return Qt;
#endif /* not DOS_NT */
}
encoded_filename = ENCODE_FILE (filename);
- fd = open (XSTRING (encoded_filename)->data, O_RDONLY);
+ fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
if (fd < 0)
report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
- close (fd);
+ emacs_close (fd);
return Qnil;
}
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
- if (CONSP (val) && CONSP (XCONS (val)->cdr))
- inserted = XINT (XCONS (XCONS (val)->cdr)->car);
+ if (CONSP (val) && CONSP (XCDR (val)))
+ inserted = XINT (XCAR (XCDR (val)));
goto handled;
}
#ifndef APOLLO
if (stat (XSTRING (filename)->data, &st) < 0)
#else
- if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0
+ if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
#endif /* WINDOWSNT */
{
- if (fd >= 0) close (fd);
+ if (fd >= 0) emacs_close (fd);
badopen:
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
#endif
if (fd < 0)
- if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0)
+ if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
if (! not_regular)
{
XSETINT (end, st.st_size);
- if (XINT (end) != st.st_size)
+
+ /* Arithmetic overflow can occur if an Emacs integer cannot
+ represent the file size, or if the calculations below
+ overflow. The calculations below double the file size
+ twice, so check that it can be multiplied by 4 safely. */
+ if (XINT (end) != st.st_size
+ || ((int) st.st_size * 4) / 4 != st.st_size)
error ("Maximum buffer size exceeded");
}
}
int how_many, nread;
if (st.st_size <= (1024 * 4))
- nread = read (fd, read_buf, 1024 * 4);
+ nread = emacs_read (fd, read_buf, 1024 * 4);
else
{
- nread = read (fd, read_buf, 1024);
+ nread = emacs_read (fd, read_buf, 1024);
if (nread >= 0)
{
if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
- nread += read (fd, read_buf + nread, 1024 * 3);
+ nread += emacs_read (fd, read_buf + nread, 1024 * 3);
}
}
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (nread > 0)
{
int count = specpdl_ptr - specpdl;
args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
coding_systems = Ffind_operation_coding_system (6, args);
if (CONSP (coding_systems))
- val = XCONS (coding_systems)->car;
+ val = XCAR (coding_systems);
}
}
{
int nread, bufpos;
- nread = read (fd, buffer, sizeof buffer);
+ nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (nread == 0)
break;
there's no need to replace anything. */
if (same_at_start - BEGV_BYTE == XINT (end))
{
- close (fd);
+ emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
del_range_1 (same_at_start, same_at_end, 0);
total_read = 0;
while (total_read < trial)
{
- nread = read (fd, buffer + total_read, trial - total_read);
+ nread = emacs_read (fd, buffer + total_read, trial - total_read);
if (nread <= 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
total_read += nread;
}
/* Scan this bufferful from the end, comparing with
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, destination, trytry);
+ this = emacs_read (fd, destination, trytry);
immediate_quit = 0;
if (this < 0 || this + unprocessed == 0)
if (how_much == -1)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
if (bufpos == inserted)
{
xfree (conversion_buffer);
- close (fd);
+ emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
del_range_byte (same_at_start, same_at_end, 0);
inserted = PT - temp;
free (conversion_buffer);
- close (fd);
+ emacs_close (fd);
specpdl_ptr--;
goto handled;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, BYTE_POS_ADDR (PT_BYTE + inserted - 1) + 1, trytry);
+ this = emacs_read (fd, BYTE_POS_ADDR (PT_BYTE + inserted - 1) + 1,
+ trytry);
immediate_quit = 0;
if (this <= 0)
/* Put an anchor to ensure multi-byte form ends at gap. */
*GPT_ADDR = 0;
- close (fd);
+ emacs_close (fd);
/* Discard the unwind protect for closing the file. */
specpdl_ptr--;
if (how_much < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
if (! coding_system_decided)
{
args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
coding_systems = Ffind_operation_coding_system (6, args);
if (CONSP (coding_systems))
- val = XCONS (coding_systems)->car;
+ val = XCAR (coding_systems);
}
}
that means do not print the \"Wrote file\" message.\n\
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
use for locking and unlocking, overriding FILENAME and VISIT.\n\
-The optional seventh arg CONFIRM, if non-nil, says ask for confirmation\n\
- before overwriting an existing file.\n\
+The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
+ for an existing file with the same name. If MUSTBENEW is `excl',\n\
+ that means to get an error if the file already exists; never overwrite.\n\
+ If MUSTBENEW is neither nil nor `excl', that means ask for\n\
+ confirmation before overwriting, but do go ahead and overwrite the file\n\
+ if the user confirms.\n\
Kludgy feature: if START is a string, then that string is written\n\
to the file, instead of any buffer contents, and END is ignored.\n\
\n\
`file-coding-system-alist', and sets the variable\n\
`last-coding-system-used' to the coding system actually used.")
- (start, end, filename, append, visit, lockname, confirm)
- Lisp_Object start, end, filename, append, visit, lockname, confirm;
+ (start, end, filename, append, visit, lockname, mustbenew)
+ Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
{
register int desc;
int failure;
args[3] = filename; args[4] = append; args[5] = visit;
args[6] = lockname;
coding_systems = Ffind_operation_coding_system (7, args);
- if (CONSP (coding_systems) && !NILP (XCONS (coding_systems)->cdr))
- val = XCONS (coding_systems)->cdr;
+ if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
+ val = XCDR (coding_systems);
}
if (NILP (val)
filename = Fexpand_file_name (filename, Qnil);
- if (! NILP (confirm))
+ if (! NILP (mustbenew) && mustbenew != Qexcl)
barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
if (STRINGP (visit))
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
- desc = open (fn, O_WRONLY | buffer_file_type);
+ desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
#else /* not DOS_NT */
- desc = open (fn, O_WRONLY);
+ desc = emacs_open (fn, O_WRONLY, 0);
#endif /* not DOS_NT */
if (desc < 0 && (NILP (append) || errno == ENOENT))
if (auto_saving) /* Overwrite any previous version of autosave file */
{
vms_truncate (fn); /* if fn exists, truncate to zero length */
- desc = open (fn, O_RDWR);
+ desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
? XSTRING (current_buffer->filename)->data : 0,
/* We can't make a new version;
try to truncate and rewrite existing version if any. */
vms_truncate (fn);
- desc = open (fn, O_RDWR);
+ desc = emacs_open (fn, O_RDWR, 0);
}
#endif
}
}
#else /* not VMS */
#ifdef DOS_NT
- desc = open (fn,
- O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type,
- S_IREAD | S_IWRITE);
+ desc = emacs_open (fn,
+ O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type
+ | (mustbenew == Qexcl ? O_EXCL : 0),
+ S_IREAD | S_IWRITE);
#else /* not DOS_NT */
- desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
+ desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
+ | (mustbenew == Qexcl ? O_EXCL : 0),
+ auto_saving ? auto_save_mode_bits : 0666);
#endif /* not DOS_NT */
#endif /* not VMS */
#endif
/* NFS can report a write failure now. */
- if (close (desc) < 0)
+ if (emacs_close (desc) < 0)
failure = 1, save_errno = errno;
#ifdef VMS
if (failure)
error ("IO error writing %s: %s", XSTRING (filename)->data,
- strerror (save_errno));
+ emacs_strerror (save_errno));
if (visiting)
{
nbytes -= coding->consumed, addr += coding->consumed;
if (coding->produced > 0)
{
- coding->produced -= write (desc, buf, coding->produced);
+ coding->produced -= emacs_write (desc, buf, coding->produced);
if (coding->produced) return -1;
}
if (result == CODING_FINISH_INSUFFICIENT_SRC)
{
/* The source text ends by an incomplete multibyte form.
There's no way other than write it out as is. */
- nbytes -= write (desc, addr, nbytes);
+ nbytes -= emacs_write (desc, addr, nbytes);
if (nbytes) return -1;
}
if (nbytes <= 0)
{
auto_saving = 0;
if (!NILP (stream))
- fclose ((FILE *) (XFASTINT (XCONS (stream)->car) << 16
- | XFASTINT (XCONS (stream)->cdr)));
+ fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
+ | XFASTINT (XCDR (stream))));
return Qnil;
}
/* Arrange to close that file whether or not we get an error.
Also reset auto_saving to 0. */
lispstream = Fcons (Qnil, Qnil);
- XSETFASTINT (XCONS (lispstream)->car, (EMACS_UINT)stream >> 16);
- XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff);
+ XSETFASTINT (XCAR (lispstream), (EMACS_UINT)stream >> 16);
+ XSETFASTINT (XCDR (lispstream), (EMACS_UINT)stream & 0xffff);
}
else
lispstream = Qnil;
autosave perfectly ordinary files because it couldn't handle some
ange-ftp'd file. */
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
- for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
{
- buf = XCONS (XCONS (tail)->car)->cdr;
+ buf = XCDR (XCAR (tail));
b = XBUFFER (buf);
/* Record all the buffers that have auto save mode
Qfile_name_history, default_filename, Qnil);
tem = Fsymbol_value (Qfile_name_history);
- if (CONSP (tem) && EQ (XCONS (tem)->car, val))
+ if (CONSP (tem) && EQ (XCAR (tem), val))
replace_in_history = 1;
/* If Fcompleting_read returned the inserted default string itself
if (replace_in_history)
/* Replace what Fcompleting_read added to the history
with what we will actually return. */
- XCONS (Fsymbol_value (Qfile_name_history))->car = double_dollars (val);
+ XCAR (Fsymbol_value (Qfile_name_history)) = double_dollars (val);
else if (add_to_history)
{
/* Add the value to the history--but not if it matches
the last value already there. */
Lisp_Object val1 = double_dollars (val);
tem = Fsymbol_value (Qfile_name_history);
- if (! CONSP (tem) || NILP (Fequal (XCONS (tem)->car, val1)))
+ if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
Fset (Qfile_name_history,
Fcons (val1, tem));
}
staticpro (&Qfile_already_exists);
Qfile_date_error = intern ("file-date-error");
staticpro (&Qfile_date_error);
+ Qexcl = intern ("excl");
+ staticpro (&Qexcl);
#ifdef DOS_NT
Qfind_buffer_file_type = intern ("find-buffer-file-type");