fileio.c 205 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* File IO for GNU Emacs.
Glenn Morris's avatar
Glenn Morris committed
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1988, 1993-2019 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19

20
#include <config.h>
21
#include <limits.h>
22
#include <fcntl.h>
23
#include "sysstdio.h"
Jim Blandy's avatar
Jim Blandy committed
24 25
#include <sys/types.h>
#include <sys/stat.h>
26 27
#include <unistd.h>

28 29 30 31
#ifdef DARWIN_OS
#include <sys/attr.h>
#endif

32
#ifdef HAVE_PWD_H
Jim Blandy's avatar
Jim Blandy committed
33
#include <pwd.h>
Jim Blandy's avatar
Jim Blandy committed
34 35
#endif

Jim Blandy's avatar
Jim Blandy committed
36 37
#include <errno.h>

Karel Klíc's avatar
Karel Klíc committed
38 39 40 41 42
#ifdef HAVE_LIBSELINUX
#include <selinux/selinux.h>
#include <selinux/context.h>
#endif

43
#if USE_ACL && defined HAVE_ACL_SET_FILE
44 45 46
#include <sys/acl.h>
#endif

47 48
#include <c-ctype.h>

Jim Blandy's avatar
Jim Blandy committed
49
#include "lisp.h"
50
#include "composite.h"
51
#include "character.h"
52
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
53
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
54
#include "window.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
55
#include "blockinput.h"
56
#include "region-cache.h"
Karoly Lorentey's avatar
Karoly Lorentey committed
57
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
58

59 60 61 62 63
#ifdef HAVE_LINUX_FS_H
# include <sys/ioctl.h>
# include <linux/fs.h>
#endif

64 65 66
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
67 68 69 70
/* The redundant #ifdef is to avoid compiler warning about unused macro.  */
#ifdef NOMINMAX
#undef NOMINMAX
#endif
71
#include <sys/file.h>
72
#include "w32.h"
73 74
#endif /* not WINDOWSNT */

Eli Zaretskii's avatar
Eli Zaretskii committed
75 76 77 78 79
#ifdef MSDOS
#include "msdos.h"
#include <sys/param.h>
#endif

80 81
#ifdef DOS_NT
/* On Windows, drive letters must be alphabetic - on DOS, the Netware
82
   redirector allows the six letters between 'Z' and 'a' as well.  */
83 84 85 86
#ifdef MSDOS
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
87
#define IS_DRIVE(x) c_isalpha (x)
88
#endif
89
/* Need to lower-case the drive letter, or else expanded
Paul Eggert's avatar
Paul Eggert committed
90
   filenames will sometimes compare unequal, because
91
   `expand-file-name' doesn't always down-case the drive letter.  */
92
#define DRIVE_LETTER(x) c_tolower (x)
93 94
#endif

Jim Blandy's avatar
Jim Blandy committed
95
#include "systime.h"
96
#include <acl.h>
97 98
#include <allocator.h>
#include <careadlinkat.h>
99
#include <dosname.h>
100
#include <fsusage.h>
101
#include <stat-time.h>
102
#include <tempname.h>
Jim Blandy's avatar
Jim Blandy committed
103

104 105
#include <binary-io.h>

Jim Blandy's avatar
Jim Blandy committed
106 107
#ifdef HPUX
#include <netio.h>
108
#endif
Jim Blandy's avatar
Jim Blandy committed
109

110 111
#include "commands.h"

112 113
/* True during writing of auto-save files.  */
static bool auto_saving;
Jim Blandy's avatar
Jim Blandy committed
114

115 116 117
/* Emacs's real umask.  */
static mode_t realmask;

118
/* Nonzero umask during creation of auto-save directories.  */
119
static mode_t auto_saving_dir_umask;
120

Jim Blandy's avatar
Jim Blandy committed
121
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
122
   a new file with the same mode as the original.  */
123
static mode_t auto_save_mode_bits;
Jim Blandy's avatar
Jim Blandy committed
124

125
/* Set by auto_save_1 if an error occurred during the last auto-save.  */
126
static bool auto_save_error_occurred;
127

128
/* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
129
   number of a file system where time stamps were observed to work.  */
130 131 132
static bool valid_timestamp_file_system;
static dev_t timestamp_file_system;

133 134
/* Each time an annotation function changes the buffer, the new buffer
   is added here.  */
135
static Lisp_Object Vwrite_region_annotation_buffers;
136

137
static Lisp_Object file_name_directory (Lisp_Object);
138 139 140 141
static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
		     Lisp_Object *, struct coding_system *);
static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
		     struct coding_system *);
142

143

144 145
/* Test whether FILE is accessible for AMODE.
   Return true if successful, false (setting errno) otherwise.  */
146

147
bool
148
file_access_p (char const *file, int amode)
149 150
{
#ifdef MSDOS
151
  if (amode & W_OK)
152
    {
153
      /* FIXME: The MS-DOS faccessat implementation should handle this.  */
154
      struct stat st;
155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
      if (stat (file, &st) != 0)
	return false;
      errno = EPERM;
      return st.st_mode & S_IWRITE || S_ISDIR (st.st_mode);
    }
#endif

  if (faccessat (AT_FDCWD, file, amode, AT_EACCESS) == 0)
    return true;

#ifdef CYGWIN
  /* Return success if faccessat failed because Cygwin couldn't
     determine the file's UID or GID.  */
  int err = errno;
  struct stat st;
  if (stat (file, &st) == 0 && (st.st_uid == -1 || st.st_gid == -1))
    return true;
  errno = err;
#endif

  return false;
176
}
177

178
/* Signal a file-access failure.  STRING describes the failure,
179 180 181 182 183
   NAME the file involved, and ERRORNO the errno value.

   If NAME is neither null nor a pair, package it up as a singleton
   list before reporting it; this saves report_file_errno's caller the
   trouble of preserving errno before calling list1.  */
184

185 186
Lisp_Object
get_file_errno_data (char const *string, Lisp_Object name, int errorno)
Jim Blandy's avatar
Jim Blandy committed
187
{
188
  Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Paul Eggert's avatar
Paul Eggert committed
189
  char *str = emacs_strerror (errorno);
Paul Eggert's avatar
Paul Eggert committed
190
  AUTO_STRING (unibyte_str, str);
191
  Lisp_Object errstring
Paul Eggert's avatar
Paul Eggert committed
192
    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
193 194 195
  Lisp_Object errdata = Fcons (errstring, data);

  if (errorno == EEXIST)
196
    return Fcons (Qfile_already_exists, errdata);
197
  else
198 199 200 201 202 203 204 205 206 207
    return Fcons (errorno == ENOENT ? Qfile_missing : Qfile_error,
		  Fcons (build_string (string), errdata));
}

void
report_file_errno (char const *string, Lisp_Object name, int errorno)
{
  Lisp_Object data = get_file_errno_data (string, name, errorno);

  xsignal (Fcar (data), Fcdr (data));
Jim Blandy's avatar
Jim Blandy committed
208
}
209

210
/* Signal a file-access failure that set errno.  STRING describes the
211 212 213
   failure, NAME the file involved.  When invoking this function, take
   care to not use arguments such as build_string ("foo") that involve
   side effects that may set errno.  */
214

215
void
216
report_file_error (char const *string, Lisp_Object name)
217
{
218
  report_file_errno (string, name, errno);
219 220
}

221
#ifdef USE_FILE_NOTIFY
222 223 224 225 226
/* Like report_file_error, but reports a file-notify-error instead.  */

void
report_file_notify_error (const char *string, Lisp_Object name)
{
Paul Eggert's avatar
Paul Eggert committed
227
  char *str = emacs_strerror (errno);
Paul Eggert's avatar
Paul Eggert committed
228
  AUTO_STRING (unibyte_str, str);
229
  Lisp_Object errstring
Paul Eggert's avatar
Paul Eggert committed
230
    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
Paul Eggert's avatar
Paul Eggert committed
231
  Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
232 233 234 235
  Lisp_Object errdata = Fcons (errstring, data);

  xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
}
236
#endif
237

238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
/* ACTION failed for FILE with errno ERR.  Signal an error if ERR
   means the file's metadata could not be retrieved even though it may
   exist, otherwise return nil.  */

static Lisp_Object
file_metadata_errno (char const *action, Lisp_Object file, int err)
{
  if (err == ENOENT || err == ENOTDIR || err == 0)
    return Qnil;
  report_file_errno (action, file, err);
}

Lisp_Object
file_attribute_errno (Lisp_Object file, int err)
{
  return file_metadata_errno ("Getting attributes", file, err);
}

256 257
void
close_file_unwind (int fd)
258
{
259
  emacs_close (fd);
260
}
261

262 263 264 265 266 267 268
void
fclose_unwind (void *arg)
{
  FILE *stream = arg;
  fclose (stream);
}

269 270
/* Restore point, having saved it as a marker.  */

271
void
272
restore_point_unwind (Lisp_Object location)
273
{
274
  Fgoto_char (location);
Dmitry Antipov's avatar
Dmitry Antipov committed
275
  unchain_marker (XMARKER (location));
276
}
277

Jim Blandy's avatar
Jim Blandy committed
278

Paul Eggert's avatar
Paul Eggert committed
279
DEFUN ("find-file-name-handler", Ffind_file_name_handler,
280
       Sfind_file_name_handler, 2, 2, 0,
281 282 283 284 285
       doc: /* Return FILENAME's handler function for OPERATION, if it has one.
Otherwise, return nil.
A file name is handled if one of the regular expressions in
`file-name-handler-alist' matches it.

286
If OPERATION equals `inhibit-file-name-operation', then ignore
287
any handlers that are members of `inhibit-file-name-handlers',
288
but still do run any other handlers.  This lets handlers
289
use the standard functions without calling themselves recursively.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
290
  (Lisp_Object filename, Lisp_Object operation)
291
{
292
  /* This function must not munge the match data.  */
293
  Lisp_Object chain, inhibited_handlers, result;
294
  ptrdiff_t pos = -1;
295

296
  result = Qnil;
297
  CHECK_STRING (filename);
298

299 300 301 302
  if (EQ (operation, Vinhibit_file_name_operation))
    inhibited_handlers = Vinhibit_file_name_handlers;
  else
    inhibited_handlers = Qnil;
303

304
  for (chain = Vfile_name_handler_alist; CONSP (chain);
305
       chain = XCDR (chain))
306 307
    {
      Lisp_Object elt;
308
      elt = XCAR (chain);
309
      if (CONSP (elt))
310
	{
311
	  Lisp_Object string = XCAR (elt);
312
	  ptrdiff_t match_pos;
313
	  Lisp_Object handler = XCDR (elt);
314 315 316 317
	  Lisp_Object operations = Qnil;

	  if (SYMBOLP (handler))
	    operations = Fget (handler, Qoperations);
318

319
	  if (STRINGP (string)
320 321
	      && (match_pos = fast_string_match (string, filename)) > pos
	      && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
322
	    {
323
	      Lisp_Object tem;
324

325
	      handler = XCDR (elt);
326 327
	      tem = Fmemq (handler, inhibited_handlers);
	      if (NILP (tem))
328 329 330 331
		{
		  result = handler;
		  pos = match_pos;
		}
332
	    }
333
	}
334

Paul Eggert's avatar
Paul Eggert committed
335
      maybe_quit ();
336
    }
337
  return result;
338 339
}

Paul Eggert's avatar
Paul Eggert committed
340
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
341 342 343
       1, 1, 0,
       doc: /* Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
344
Otherwise return a directory name.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
345
Given a Unix syntax file name, returns a string ending in slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
346
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
347
{
348
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
349

350
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
351

352
  /* If the file name has special constructs in it,
353
     call the corresponding file name handler.  */
354
  handler = Ffind_file_name_handler (filename, Qfile_name_directory);
355
  if (!NILP (handler))
356 357 358 359 360
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
361

362 363 364 365 366 367 368 369 370
  return file_name_directory (filename);
}

/* Return the directory component of FILENAME, or nil if FILENAME does
   not contain a directory component.  */

static Lisp_Object
file_name_directory (Lisp_Object filename)
{
371 372
  char *beg = SSDATA (filename);
  char const *p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
373

374 375
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
376
	 /* only recognize drive specifier at the beginning */
377 378 379 380
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" and "/:foo" cases correctly  */
	      && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
		  || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
381
#endif
Jim Blandy's avatar
Jim Blandy committed
382 383 384 385
	 ) p--;

  if (p == beg)
    return Qnil;
386
#ifdef DOS_NT
387
  /* Expansion of "c:" to drive and default directory.  */
388 389 390 391 392
  Lisp_Object tem_fn;
  USE_SAFE_ALLOCA;
  SAFE_ALLOCA_STRING (beg, filename);
  p = beg + (p - SSDATA (filename));

393
  if (p[-1] == ':')
394 395
    {
      /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
396 397
      char *res = alloca (MAXPATHLEN + 1);
      char *r = res;
398 399 400

      if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
	{
401
	  memcpy (res, beg, 2);
402 403 404 405
	  beg += 2;
	  r += 2;
	}

406
      if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
407
	{
408 409 410
	  size_t l = strlen (res);

	  if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
411 412 413
	    strcat (res, "/");
	  beg = res;
	  p = beg + strlen (beg);
414
	  dostounix_filename (beg);
415 416
	  tem_fn = make_specified_string (beg, -1, p - beg,
					  STRING_MULTIBYTE (filename));
417
	}
418 419 420 421 422 423
      else
	tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
					STRING_MULTIBYTE (filename));
    }
  else if (STRING_MULTIBYTE (filename))
    {
424
      tem_fn = make_specified_string (beg, -1, p - beg, 1);
425
      dostounix_filename (SSDATA (tem_fn));
426 427 428 429
#ifdef WINDOWSNT
      if (!NILP (Vw32_downcase_file_names))
	tem_fn = Fdowncase (tem_fn);
#endif
430 431 432
    }
  else
    {
433
      dostounix_filename (beg);
434
      tem_fn = make_specified_string (beg, -1, p - beg, 0);
435
    }
436
  SAFE_FREE ();
437
  return tem_fn;
438
#else  /* DOS_NT */
439
  return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
440
#endif	/* DOS_NT */
Jim Blandy's avatar
Jim Blandy committed
441 442
}

Paul Eggert's avatar
Paul Eggert committed
443
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
444
       Sfile_name_nondirectory, 1, 1, 0,
445 446 447 448
       doc: /* Return file name FILENAME sans its directory.
For example, in a Unix-syntax file name,
this is everything after the last slash,
or the entire name if it contains no slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
449
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
450
{
451
  register const char *beg, *p, *end;
452
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
453

454
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
455

456
  /* If the file name has special constructs in it,
457
     call the corresponding file name handler.  */
458
  handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
459
  if (!NILP (handler))
460 461 462 463 464 465 466
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
					filename);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }
467

468
  beg = SSDATA (filename);
469
  end = p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
470

471 472
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
473
	 /* only recognize drive specifier at beginning */
474 475 476
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" case correctly  */
	      && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
477
#endif
478 479
	 )
    p--;
Jim Blandy's avatar
Jim Blandy committed
480

481
  return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
Jim Blandy's avatar
Jim Blandy committed
482
}
483

Paul Eggert's avatar
Paul Eggert committed
484
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
485
       Sunhandled_file_name_directory, 1, 1, 0,
486 487
       doc: /* Return a directly usable directory name somehow associated with FILENAME.
A `directly usable' directory name is one that may be used without the
488
intervention of any file name handler.
489
If FILENAME is a directly usable file itself, return
490
\(file-name-as-directory FILENAME).
Stefan Monnier's avatar
Stefan Monnier committed
491 492
If FILENAME refers to a file which is not accessible from a local process,
then this should return nil.
493 494
The `call-process' and `start-process' functions use this function to
get a current directory to run processes in.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
495
  (Lisp_Object filename)
496 497 498 499
{
  Lisp_Object handler;

  /* If the file name has special constructs in it,
500
     call the corresponding file name handler.  */
501
  handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
502
  if (!NILP (handler))
503 504 505 506 507
    {
      Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
508

509
  return Ffile_name_as_directory (filename);
510 511
}

512 513 514 515
/* Maximum number of bytes that DST will be longer than SRC
   in file_name_as_directory.  This occurs when SRCLEN == 0.  */
enum { file_name_as_directory_slop = 2 };

516 517 518 519
/* Convert from file name SRC of length SRCLEN to directory name in
   DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
   string.  On UNIX, just make sure there is a terminating /.  Return
   the length of DST in bytes.  */
Jim Blandy's avatar
Jim Blandy committed
520

521
static ptrdiff_t
522 523
file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
			bool multibyte)
524 525
{
  if (srclen == 0)
526
    {
527 528 529 530
      dst[0] = '.';
      dst[1] = '/';
      dst[2] = '\0';
      return 2;
531 532
    }

533
  memcpy (dst, src, srclen);
534
  if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
535 536
    dst[srclen++] = DIRECTORY_SEP;
  dst[srclen] = 0;
537
#ifdef DOS_NT
538
  dostounix_filename (dst);
539
#endif
540
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
541 542
}

Paul Eggert's avatar
Paul Eggert committed
543
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Jim Blandy's avatar
Jim Blandy committed
544
       Sfile_name_as_directory, 1, 1, 0,
545
       doc: /* Return a string representing the file name FILE interpreted as a directory.
546 547 548 549
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
The result can be used as the value of `default-directory'
or passed as second argument to `expand-file-name'.
Karl Fogel's avatar
Karl Fogel committed
550 551
For a Unix-syntax file name, just appends a slash unless a trailing slash
is already present.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
552
  (Lisp_Object file)
Jim Blandy's avatar
Jim Blandy committed
553 554
{
  char *buf;
555
  ptrdiff_t length;
556 557
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
558

559
  CHECK_STRING (file);
560 561

  /* If the file name has special constructs in it,
562
     call the corresponding file name handler.  */
563
  handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
564
  if (!NILP (handler))
565 566 567 568 569 570 571
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
					file);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }
572

573 574 575 576
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    file = Fdowncase (file);
#endif
577
  buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
578 579
  length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
				   STRING_MULTIBYTE (file));
580 581 582
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
583 584
}

585 586 587 588
/* Convert from directory name SRC of length SRCLEN to file name in
   DST.  MULTIBYTE non-zero means the file name in SRC is a multibyte
   string.  On UNIX, just make sure there isn't a terminating /.
   Return the length of DST in bytes.  */
Jim Blandy's avatar
Jim Blandy committed
589

590
static ptrdiff_t
591
directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
Jim Blandy's avatar
Jim Blandy committed
592
{
593 594 595 596 597
  /* In Unix-like systems, just remove any final slashes.  However, if
     they are all slashes, leave "/" and "//" alone, and treat "///"
     and longer as if they were "/".  */
  if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
    while (srclen > 1
598
#ifdef DOS_NT
599
	   && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2]))
600
#endif
601 602
	   && IS_DIRECTORY_SEP (src[srclen - 1]))
      srclen--;
603 604 605

  memcpy (dst, src, srclen);
  dst[srclen] = 0;
606
#ifdef DOS_NT
607
  dostounix_filename (dst);
608
#endif
609
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
610 611
}

612 613 614 615 616 617 618 619 620 621
DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0,
       doc: /* Return non-nil if NAME ends with a directory separator character.  */)
  (Lisp_Object name)
{
  CHECK_STRING (name);
  ptrdiff_t namelen = SBYTES (name);
  unsigned char c = namelen ? SREF (name, namelen - 1) : 0;
  return IS_DIRECTORY_SEP (c) ? Qt : Qnil;
}

622 623 624 625 626
/* Return the expansion of NEWNAME, except that if NEWNAME is a
   directory name then return the expansion of FILE's basename under
   NEWNAME.  This resembles how 'cp FILE NEWNAME' works, except that
   it requires NEWNAME to be a directory name (typically, by ending in
   "/").  */
627 628 629 630

static Lisp_Object
expand_cp_target (Lisp_Object file, Lisp_Object newname)
{
631
  return (!NILP (Fdirectory_name_p (newname))
632 633 634 635
	  ? Fexpand_file_name (Ffile_name_nondirectory (file), newname)
	  : Fexpand_file_name (newname, Qnil));
}

Paul Eggert's avatar
Paul Eggert committed
636
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
637 638 639 640 641
       1, 1, 0,
       doc: /* Returns the file name of the directory named DIRECTORY.
This is the name of the file that holds the data for the directory DIRECTORY.
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
642
In Unix-syntax, this function just removes the final slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
643
  (Lisp_Object directory)
Jim Blandy's avatar
Jim Blandy committed
644 645
{
  char *buf;
646
  ptrdiff_t length;
647 648
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
649

650
  CHECK_STRING (directory);
Jim Blandy's avatar
Jim Blandy committed
651

652
  /* If the file name has special constructs in it,
653
     call the corresponding file name handler.  */
654
  handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
655
  if (!NILP (handler))
656 657 658 659 660 661 662
    {
      Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
					directory);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }
663

664 665 666 667
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    directory = Fdowncase (directory);
#endif
668
  buf = SAFE_ALLOCA (SBYTES (directory) + 1);
669 670
  length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
				STRING_MULTIBYTE (directory));
671 672 673
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
674 675
}

676
DEFUN ("make-temp-file-internal", Fmake_temp_file_internal,
677
       Smake_temp_file_internal, 4, 4, 0,
678 679 680 681
       doc: /* Generate a new file whose name starts with PREFIX, a string.
Return the name of the generated file.  If DIR-FLAG is zero, do not
create the file, just its name.  Otherwise, if DIR-FLAG is non-nil,
create an empty directory.  The file name should end in SUFFIX.
682
Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
683 684
working directory.  If TEXT is a string, insert it into the newly
created file.
685

686
Signal an error if the file could not be created.
687

688
This function does not grok magic file names.  */)
689 690
  (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix,
   Lisp_Object text)
Jim Blandy's avatar
Jim Blandy committed
691
{
692
  CHECK_STRING (prefix);
693 694 695 696 697 698 699 700 701 702 703 704 705 706
  CHECK_STRING (suffix);
  Lisp_Object encoded_prefix = ENCODE_FILE (prefix);
  Lisp_Object encoded_suffix = ENCODE_FILE (suffix);
  ptrdiff_t prefix_len = SBYTES (encoded_prefix);
  ptrdiff_t suffix_len = SBYTES (encoded_suffix);
  if (INT_MAX < suffix_len)
    args_out_of_range (prefix, suffix);
  int nX = 6;
  Lisp_Object val = make_uninit_string (prefix_len + nX + suffix_len);
  char *data = SSDATA (val);
  memcpy (data, SSDATA (encoded_prefix), prefix_len);
  memset (data + prefix_len, 'X', nX);
  memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
  int kind = (NILP (dir_flag) ? GT_FILE
707
	      : EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE
708 709
	      : GT_DIR);
  int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
710 711 712
  bool failed = fd < 0;
  if (!failed)
    {
713 714
      ptrdiff_t count = SPECPDL_INDEX ();
      record_unwind_protect_int (close_file_unwind, fd);
715 716 717 718
      val = DECODE_FILE (val);
      if (STRINGP (text) && SBYTES (text) != 0)
	write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd);
      failed = NILP (dir_flag) && emacs_close (fd) != 0;
719 720
      /* Discard the unwind protect.  */
      specpdl_ptr = specpdl + count;
721 722
    }
  if (failed)
723
    {
724
      static char const kind_message[][32] =
725
	{
726 727 728 729 730
	  [GT_FILE] = "Creating file with prefix",
	  [GT_DIR] = "Creating directory with prefix",
	  [GT_NOCREATE] = "Creating file name with prefix"
	};
      report_file_error (kind_message[kind], prefix);
731
    }
732
  return val;
Jim Blandy's avatar
Jim Blandy committed
733
}
734

735 736

DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
737 738
       doc: /* Generate temporary file name (string) starting with PREFIX (a string).

739
This function tries to choose a name that has no existing file.
740 741
For this to work, PREFIX should be an absolute file name, and PREFIX
and the returned string should both be non-magic.
742

743 744 745
There is a race condition between calling `make-temp-name' and
later creating the file, which opens all kinds of security holes.
For that reason, you should normally use `make-temp-file' instead.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
746
  (Lisp_Object prefix)
747
{
748
  return Fmake_temp_file_internal (prefix, make_fixnum (0),
749
				   empty_unibyte_string, Qnil);
750 751
}

752 753 754 755 756 757 758
/* NAME must be a string.  */
static bool
file_name_absolute_no_tilde_p (Lisp_Object name)
{
  return IS_ABSOLUTE_FILE_NAME (SSDATA (name));
}

759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783
/* Return the home directory of the user NAME, or a null pointer if
   NAME is empty or the user does not exist or the user's home
   directory is not an absolute file name.  NAME is an array of bytes
   that continues up to (but not including) the next NUL byte or
   directory separator.  The returned string lives in storage good
   until the next call to this or similar functions.  */
static char *
user_homedir (char const *name)
{
  ptrdiff_t length;
  for (length = 0; name[length] && !IS_DIRECTORY_SEP (name[length]); length++)
    continue;
  if (length == 0)
    return NULL;
  USE_SAFE_ALLOCA;
  char *p = SAFE_ALLOCA (length + 1);
  memcpy (p, name, length);
  p[length] = 0;
  struct passwd *pw = getpwnam (p);
  SAFE_FREE ();
  if (!pw || (pw->pw_dir && !IS_ABSOLUTE_FILE_NAME (pw->pw_dir)))
    return NULL;
  return pw->pw_dir;
}

Paul Eggert's avatar
Paul Eggert committed
784
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
785 786
       doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
787
\(does not start with slash or tilde); both the directory name and
788 789
a directory's file name are accepted.  If DEFAULT-DIRECTORY is nil or
missing, the current buffer's value of `default-directory' is used.
790 791
NAME should be a string that is a valid file name for the underlying
filesystem.
792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807

File name components that are `.' are removed, and so are file name
components followed by `..', along with the `..' itself; note that
these simplifications are done without checking the resulting file
names in the file system.

Multiple consecutive slashes are collapsed into a single slash, except
at the beginning of the file name when they are significant (e.g., UNC
file names on MS-Windows.)

An initial \"~\" in NAME expands to your home directory.

An initial \"~USER\" in NAME expands to USER's home directory.  If
USER doesn't exist, \"~USER\" is not expanded.

To do other file name substitutions, see `substitute-in-file-name'.
Chong Yidong's avatar
Chong Yidong committed
808 809 810

For technical reasons, this function can return correct but
non-intuitive results for the root directory; for instance,
811 812
\(expand-file-name ".." "/") returns "/..".  For this reason, use
\(directory-file-name (file-name-directory dirname)) to traverse a
813 814 815
filesystem tree, not (expand-file-name ".." dirname).  Note: make
sure DIRNAME in this example doesn't end in a slash, unless it's
the root directory.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
816
  (Lisp_Object name, Lisp_Object default_directory)
Jim Blandy's avatar
Jim Blandy committed
817
{
818 819
  /* These point to SDATA and need to be careful with string-relocation
     during GC (via DECODE_FILE).  */
820
  char *nm;
821
  char *nmlim;
822
  const char *newdir;
823
  const char *newdirlim;
824
  /* This should only point to alloca'd data.  */
825
  char *target;
826

827
  ptrdiff_t tlen;
828
#ifdef DOS_NT
829
  int drive = 0;
830
  bool collapse_newdir = true;
831
  bool is_escaped = 0;
832
#endif /* DOS_NT */
833
  ptrdiff_t length, nbytes;
834
  Lisp_Object handler, result, handled_name;
835
  bool multibyte;
836
  Lisp_Object hdir;
837
  USE_SAFE_ALLOCA;
838

839
  CHECK_STRING (name);
Jim Blandy's avatar
Jim Blandy committed
840

841
  /* If the file name has special constructs in it,
842
     call the corresponding file name handler.  */
843
  handler = Ffind_file_name_handler (name, Qexpand_file_name);
844
  if (!NILP (handler))
845 846 847 848 849 850 851 852
    {
      handled_name = call3 (handler, Qexpand_file_name,
			    name, default_directory);
      if (STRINGP (handled_name))
	return handled_name;
      error ("Invalid handler in `file-name-handler-alist'");
    }

853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868
  /* As a last resort, we may have to use the root as
     default_directory below.  */
  Lisp_Object root;
#ifdef DOS_NT
      /* "/" is not considered a root directory on DOS_NT, so using it
	 as default_directory causes an infinite recursion in, e.g.,
	 the following:

            (let (default-directory)