fileio.c 203 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 138 139 140
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 *);
141

142

143
/* Return true if FILENAME exists, otherwise return false and set errno.  */
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177

static bool
check_existing (const char *filename)
{
  return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
}

/* Return true if file FILENAME exists and can be executed.  */

static bool
check_executable (char *filename)
{
  return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
}

/* Return true if file FILENAME exists and can be accessed
   according to AMODE, which should include W_OK.
   On failure, return false and set errno.  */

static bool
check_writable (const char *filename, int amode)
{
#ifdef MSDOS
  /* FIXME: an faccessat implementation should be added to the
     DOS/Windows ports and this #ifdef branch should be removed.  */
  struct stat st;
  if (stat (filename, &st) < 0)
    return 0;
  errno = EPERM;
  return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
#else /* not MSDOS */
  bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
#ifdef CYGWIN
  /* faccessat may have returned failure because Cygwin couldn't
Stefan Monnier's avatar
Stefan Monnier committed
178
     determine the file's UID or GID; if so, we return success.  */
179 180 181 182 183 184 185 186 187 188 189 190 191
  if (!res)
    {
      int faccessat_errno = errno;
      struct stat st;
      if (stat (filename, &st) < 0)
        return 0;
      res = (st.st_uid == -1 || st.st_gid == -1);
      errno = faccessat_errno;
    }
#endif /* CYGWIN */
  return res;
#endif /* not MSDOS */
}
192

193
/* Signal a file-access failure.  STRING describes the failure,
194 195 196 197 198
   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.  */
199

200 201
Lisp_Object
get_file_errno_data (char const *string, Lisp_Object name, int errorno)
Jim Blandy's avatar
Jim Blandy committed
202
{
203
  Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Paul Eggert's avatar
Paul Eggert committed
204
  char *str = emacs_strerror (errorno);
Paul Eggert's avatar
Paul Eggert committed
205
  AUTO_STRING (unibyte_str, str);
206
  Lisp_Object errstring
Paul Eggert's avatar
Paul Eggert committed
207
    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
208 209 210
  Lisp_Object errdata = Fcons (errstring, data);

  if (errorno == EEXIST)
211
    return Fcons (Qfile_already_exists, errdata);
212
  else
213 214 215 216 217 218 219 220 221 222
    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
223
}
224

225
/* Signal a file-access failure that set errno.  STRING describes the
226 227 228
   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.  */
229

230
void
231
report_file_error (char const *string, Lisp_Object name)
232
{
233
  report_file_errno (string, name, errno);
234 235
}

236
#ifdef USE_FILE_NOTIFY
237 238 239 240 241
/* 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
242
  char *str = emacs_strerror (errno);
Paul Eggert's avatar
Paul Eggert committed
243
  AUTO_STRING (unibyte_str, str);
244
  Lisp_Object errstring
Paul Eggert's avatar
Paul Eggert committed
245
    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
Paul Eggert's avatar
Paul Eggert committed
246
  Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
247 248 249 250
  Lisp_Object errdata = Fcons (errstring, data);

  xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
}
251
#endif
252

253 254
void
close_file_unwind (int fd)
255
{
256
  emacs_close (fd);
257
}
258

259 260 261 262 263 264 265
void
fclose_unwind (void *arg)
{
  FILE *stream = arg;
  fclose (stream);
}

266 267
/* Restore point, having saved it as a marker.  */

268
void
269
restore_point_unwind (Lisp_Object location)
270
{
271
  Fgoto_char (location);
Dmitry Antipov's avatar
Dmitry Antipov committed
272
  unchain_marker (XMARKER (location));
273
}
274

Jim Blandy's avatar
Jim Blandy committed
275

Paul Eggert's avatar
Paul Eggert committed
276
DEFUN ("find-file-name-handler", Ffind_file_name_handler,
277
       Sfind_file_name_handler, 2, 2, 0,
278 279 280 281 282
       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.

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

293
  result = Qnil;
294
  CHECK_STRING (filename);
295

296 297 298 299
  if (EQ (operation, Vinhibit_file_name_operation))
    inhibited_handlers = Vinhibit_file_name_handlers;
  else
    inhibited_handlers = Qnil;
300

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

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

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

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

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

347
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
348

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

359 360
  char *beg = SSDATA (filename);
  char const *p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
361

362 363
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
364
	 /* only recognize drive specifier at the beginning */
365 366 367 368
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" and "/:foo" cases correctly  */
	      && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
		  || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
369
#endif
Jim Blandy's avatar
Jim Blandy committed
370 371 372 373
	 ) p--;

  if (p == beg)
    return Qnil;
374
#ifdef DOS_NT
375
  /* Expansion of "c:" to drive and default directory.  */
376 377 378 379 380
  Lisp_Object tem_fn;
  USE_SAFE_ALLOCA;
  SAFE_ALLOCA_STRING (beg, filename);
  p = beg + (p - SSDATA (filename));

381
  if (p[-1] == ':')
382 383
    {
      /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
384 385
      char *res = alloca (MAXPATHLEN + 1);
      char *r = res;
386 387 388

      if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
	{
389
	  memcpy (res, beg, 2);
390 391 392 393
	  beg += 2;
	  r += 2;
	}

394
      if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
395
	{
396 397 398
	  size_t l = strlen (res);

	  if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
399 400 401
	    strcat (res, "/");
	  beg = res;
	  p = beg + strlen (beg);
402
	  dostounix_filename (beg);
403 404
	  tem_fn = make_specified_string (beg, -1, p - beg,
					  STRING_MULTIBYTE (filename));
405
	}
406 407 408 409 410 411
      else
	tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
					STRING_MULTIBYTE (filename));
    }
  else if (STRING_MULTIBYTE (filename))
    {
412
      tem_fn = make_specified_string (beg, -1, p - beg, 1);
413
      dostounix_filename (SSDATA (tem_fn));
414 415 416 417
#ifdef WINDOWSNT
      if (!NILP (Vw32_downcase_file_names))
	tem_fn = Fdowncase (tem_fn);
#endif
418 419 420
    }
  else
    {
421
      dostounix_filename (beg);
422
      tem_fn = make_specified_string (beg, -1, p - beg, 0);
423
    }
424
  SAFE_FREE ();
425
  return tem_fn;
426
#else  /* DOS_NT */
427
  return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
428
#endif	/* DOS_NT */
Jim Blandy's avatar
Jim Blandy committed
429 430
}

Paul Eggert's avatar
Paul Eggert committed
431
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
432
       Sfile_name_nondirectory, 1, 1, 0,
433 434 435 436
       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
437
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
438
{
439
  register const char *beg, *p, *end;
440
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
441

442
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
443

444
  /* If the file name has special constructs in it,
445
     call the corresponding file name handler.  */
446
  handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
447
  if (!NILP (handler))
448 449 450 451 452 453 454
    {
      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'");
    }
455

456
  beg = SSDATA (filename);
457
  end = p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
458

459 460
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
461
	 /* only recognize drive specifier at beginning */
462 463 464
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" case correctly  */
	      && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
465
#endif
466 467
	 )
    p--;
Jim Blandy's avatar
Jim Blandy committed
468

469
  return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
Jim Blandy's avatar
Jim Blandy committed
470
}
471

Paul Eggert's avatar
Paul Eggert committed
472
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
473
       Sunhandled_file_name_directory, 1, 1, 0,
474 475
       doc: /* Return a directly usable directory name somehow associated with FILENAME.
A `directly usable' directory name is one that may be used without the
476
intervention of any file name handler.
477
If FILENAME is a directly usable file itself, return
478
\(file-name-as-directory FILENAME).
Stefan Monnier's avatar
Stefan Monnier committed
479 480
If FILENAME refers to a file which is not accessible from a local process,
then this should return nil.
481 482
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
483
  (Lisp_Object filename)
484 485 486 487
{
  Lisp_Object handler;

  /* If the file name has special constructs in it,
488
     call the corresponding file name handler.  */
489
  handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
490
  if (!NILP (handler))
491 492 493 494 495
    {
      Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
496

497
  return Ffile_name_as_directory (filename);
498 499
}

500 501 502 503
/* 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 };

504 505 506 507
/* 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
508

509
static ptrdiff_t
510 511
file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
			bool multibyte)
512 513
{
  if (srclen == 0)
514
    {
515 516 517 518
      dst[0] = '.';
      dst[1] = '/';
      dst[2] = '\0';
      return 2;
519 520
    }

521
  memcpy (dst, src, srclen);
522
  if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
523 524
    dst[srclen++] = DIRECTORY_SEP;
  dst[srclen] = 0;
525
#ifdef DOS_NT
526
  dostounix_filename (dst);
527
#endif
528
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
529 530
}

Paul Eggert's avatar
Paul Eggert committed
531
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Jim Blandy's avatar
Jim Blandy committed
532
       Sfile_name_as_directory, 1, 1, 0,
533
       doc: /* Return a string representing the file name FILE interpreted as a directory.
534 535 536 537
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
538 539
For a Unix-syntax file name, just appends a slash unless a trailing slash
is already present.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
540
  (Lisp_Object file)
Jim Blandy's avatar
Jim Blandy committed
541 542
{
  char *buf;
543
  ptrdiff_t length;
544 545
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
546

547
  CHECK_STRING (file);
548 549

  /* If the file name has special constructs in it,
550
     call the corresponding file name handler.  */
551
  handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
552
  if (!NILP (handler))
553 554 555 556 557 558 559
    {
      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'");
    }
560

561 562 563 564
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    file = Fdowncase (file);
#endif
565
  buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
566 567
  length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
				   STRING_MULTIBYTE (file));
568 569 570
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
571 572
}

573 574 575 576
/* 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
577

578
static ptrdiff_t
579
directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
Jim Blandy's avatar
Jim Blandy committed
580
{
581 582 583 584 585
  /* 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
586
#ifdef DOS_NT
587
	   && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2]))
588
#endif
589 590
	   && IS_DIRECTORY_SEP (src[srclen - 1]))
      srclen--;
591 592 593

  memcpy (dst, src, srclen);
  dst[srclen] = 0;
594
#ifdef DOS_NT
595
  dostounix_filename (dst);
596
#endif
597
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
598 599
}

600 601 602 603 604 605 606 607 608 609
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;
}

610 611 612 613 614
/* 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
   "/").  */
615 616 617 618

static Lisp_Object
expand_cp_target (Lisp_Object file, Lisp_Object newname)
{
619
  return (!NILP (Fdirectory_name_p (newname))
620 621 622 623
	  ? Fexpand_file_name (Ffile_name_nondirectory (file), newname)
	  : Fexpand_file_name (newname, Qnil));
}

Paul Eggert's avatar
Paul Eggert committed
624
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
625 626 627 628 629
       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
630
In Unix-syntax, this function just removes the final slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
631
  (Lisp_Object directory)
Jim Blandy's avatar
Jim Blandy committed
632 633
{
  char *buf;
634
  ptrdiff_t length;
635 636
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
637

638
  CHECK_STRING (directory);
Jim Blandy's avatar
Jim Blandy committed
639

640
  /* If the file name has special constructs in it,
641
     call the corresponding file name handler.  */
642
  handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
643
  if (!NILP (handler))
644 645 646 647 648 649 650
    {
      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'");
    }
651

652 653 654 655
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    directory = Fdowncase (directory);
#endif
656
  buf = SAFE_ALLOCA (SBYTES (directory) + 1);
657 658
  length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
				STRING_MULTIBYTE (directory));
659 660 661
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
662 663
}

664
DEFUN ("make-temp-file-internal", Fmake_temp_file_internal,
665
       Smake_temp_file_internal, 4, 4, 0,
666 667 668 669
       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.
670
Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
671 672
working directory.  If TEXT is a string, insert it into the newly
created file.
673

674
Signal an error if the file could not be created.
675

676
This function does not grok magic file names.  */)
677 678
  (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix,
   Lisp_Object text)
Jim Blandy's avatar
Jim Blandy committed
679
{
680
  CHECK_STRING (prefix);
681 682 683 684 685 686 687 688 689 690 691 692 693 694
  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
695
	      : EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE
696 697
	      : GT_DIR);
  int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
698 699 700
  bool failed = fd < 0;
  if (!failed)
    {
701 702
      ptrdiff_t count = SPECPDL_INDEX ();
      record_unwind_protect_int (close_file_unwind, fd);
703 704 705 706
      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;
707 708
      /* Discard the unwind protect.  */
      specpdl_ptr = specpdl + count;
709 710
    }
  if (failed)
711
    {
712
      static char const kind_message[][32] =
713
	{
714 715 716 717 718
	  [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);
719
    }
720
  return val;
Jim Blandy's avatar
Jim Blandy committed
721
}
722

723 724

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

727
This function tries to choose a name that has no existing file.
728 729
For this to work, PREFIX should be an absolute file name, and PREFIX
and the returned string should both be non-magic.
730

731 732 733
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
734
  (Lisp_Object prefix)
735
{
736
  return Fmake_temp_file_internal (prefix, make_fixnum (0),
737
				   empty_unibyte_string, Qnil);
738 739
}

Paul Eggert's avatar
Paul Eggert committed
740
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
741 742
       doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
743
\(does not start with slash or tilde); both the directory name and
744 745
a directory's file name are accepted.  If DEFAULT-DIRECTORY is nil or
missing, the current buffer's value of `default-directory' is used.
746 747
NAME should be a string that is a valid file name for the underlying
filesystem.
748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763

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
764 765 766

For technical reasons, this function can return correct but
non-intuitive results for the root directory; for instance,
767 768
\(expand-file-name ".." "/") returns "/..".  For this reason, use
\(directory-file-name (file-name-directory dirname)) to traverse a
769 770 771
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
772
  (Lisp_Object name, Lisp_Object default_directory)
Jim Blandy's avatar
Jim Blandy committed
773
{
774 775
  /* These point to SDATA and need to be careful with string-relocation
     during GC (via DECODE_FILE).  */
776
  char *nm;
777
  char *nmlim;
778
  const char *newdir;
779
  const char *newdirlim;
780
  /* This should only point to alloca'd data.  */
781
  char *target;
782

783
  ptrdiff_t tlen;
Jim Blandy's avatar
Jim Blandy committed
784
  struct passwd *pw;
785
#ifdef DOS_NT
786
  int drive = 0;
787
  bool collapse_newdir = true;
788
  bool is_escaped = 0;
789
#endif /* DOS_NT */
790
  ptrdiff_t length, nbytes;
791
  Lisp_Object handler, result, handled_name;
792
  bool multibyte;
793
  Lisp_Object hdir;
794
  USE_SAFE_ALLOCA;
795

796
  CHECK_STRING (name);
Jim Blandy's avatar
Jim Blandy committed
797

798
  /* If the file name has special constructs in it,
799
     call the corresponding file name handler.  */
800
  handler = Ffind_file_name_handler (name, Qexpand_file_name);
801
  if (!NILP (handler))
802 803 804 805 806 807 808 809
    {
      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'");
    }

810

811 812
  /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted.  */
  if (NILP (default_directory))
813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828
    {
      Lisp_Object dir = BVAR (current_buffer, directory);
      /* The buffer's default-directory should be absolute.  If it
	 isn't, try to expand it relative to invocation-directory.
	 But we have to be careful to avoid an infinite loop, because
	 the code in emacs.c that sets Vinvocation_directory might
	 call Fexpand_file_name.  */
      if (STRINGP (dir))
	{
	  if (!NILP (Ffile_name_absolute_p (dir)))
	    default_directory = dir;
	  else if (STRINGP (Vinvocation_directory)
		   && !NILP (Ffile_name_absolute_p (Vinvocation_directory)))
	    default_directory = Fexpand_file_name (dir, Vinvocation_directory);
	}
    }
829
  if (! STRINGP (default_directory))
830 831 832 833 834 835 836 837 838 839 840 841 842 843 844
    {
#ifdef DOS_NT
      /* "/" is not considered a root directory on DOS_NT, so using "/"
	 here causes an infinite recursion in, e.g., the following:

            (let (default-directory)
	      (expand-file-name "a"))

	 To avoid this, we set default_directory to the root of the
	 current drive.  */
      default_directory = build_string (emacs_root_dir ());
#else
      default_directory = build_string ("/");
#endif
    }
845

846 847
  handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
  if (!NILP (handler))
848
    {
849 850 851 852 853
      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'");
854
    }
855

856
  {
857
    char *o = SSDATA (default_directory);
858 859 860 861 862 863 864 865