fileio.c 195 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-2017 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 <http://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 <stat-time.h>
Jim Blandy's avatar
Jim Blandy committed
100

101 102
#include <binary-io.h>

Jim Blandy's avatar
Jim Blandy committed
103 104
#ifdef HPUX
#include <netio.h>
105
#endif
Jim Blandy's avatar
Jim Blandy committed
106

107 108
#include "commands.h"

109 110
/* True during writing of auto-save files.  */
static bool auto_saving;
Jim Blandy's avatar
Jim Blandy committed
111

112 113 114
/* Emacs's real umask.  */
static mode_t realmask;

115
/* Nonzero umask during creation of auto-save directories.  */
116
static mode_t auto_saving_dir_umask;
117

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

122
/* Set by auto_save_1 if an error occurred during the last auto-save.  */
123
static bool auto_save_error_occurred;
124

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

130 131
/* Each time an annotation function changes the buffer, the new buffer
   is added here.  */
132
static Lisp_Object Vwrite_region_annotation_buffers;
133

134 135 136 137
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 *);
138

139 140 141 142 143 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

/* Return true if FILENAME exists.  */

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
175
     determine the file's UID or GID; if so, we return success.  */
176 177 178 179 180 181 182 183 184 185 186 187 188
  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 */
}
189

190
/* Signal a file-access failure.  STRING describes the failure,
191 192 193 194 195
   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.  */
196

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

  if (errorno == EEXIST)
    xsignal (Qfile_already_exists, errdata);
  else
Paul Eggert's avatar
Paul Eggert committed
210 211
    xsignal (errorno == ENOENT ? Qfile_missing : Qfile_error,
	     Fcons (build_string (string), errdata));
Jim Blandy's avatar
Jim Blandy committed
212
}
213

214
/* Signal a file-access failure that set errno.  STRING describes the
215 216 217
   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.  */
218

219
void
220
report_file_error (char const *string, Lisp_Object name)
221
{
222
  report_file_errno (string, name, errno);
223 224
}

225 226 227 228 229
/* 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
230
  char *str = emacs_strerror (errno);
Paul Eggert's avatar
Paul Eggert committed
231
  AUTO_STRING (unibyte_str, str);
232
  Lisp_Object errstring
Paul Eggert's avatar
Paul Eggert committed
233
    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
Paul Eggert's avatar
Paul Eggert committed
234
  Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
235 236 237 238 239
  Lisp_Object errdata = Fcons (errstring, data);

  xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
}

240 241
void
close_file_unwind (int fd)
242
{
243
  emacs_close (fd);
244
}
245

246 247 248 249 250 251 252
void
fclose_unwind (void *arg)
{
  FILE *stream = arg;
  fclose (stream);
}

253 254
/* Restore point, having saved it as a marker.  */

255
void
256
restore_point_unwind (Lisp_Object location)
257
{
258
  Fgoto_char (location);
Dmitry Antipov's avatar
Dmitry Antipov committed
259
  unchain_marker (XMARKER (location));
260
}
261

Jim Blandy's avatar
Jim Blandy committed
262

Paul Eggert's avatar
Paul Eggert committed
263
DEFUN ("find-file-name-handler", Ffind_file_name_handler,
264
       Sfind_file_name_handler, 2, 2, 0,
265 266 267 268 269 270 271 272 273
       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.

If OPERATION equals `inhibit-file-name-operation', then we ignore
any handlers that are members of `inhibit-file-name-handlers',
but we still do run any other handlers.  This lets handlers
use the standard functions without calling themselves recursively.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
274
  (Lisp_Object filename, Lisp_Object operation)
275
{
276
  /* This function must not munge the match data.  */
277
  Lisp_Object chain, inhibited_handlers, result;
278
  ptrdiff_t pos = -1;
279

280
  result = Qnil;
281
  CHECK_STRING (filename);
282

283 284 285 286
  if (EQ (operation, Vinhibit_file_name_operation))
    inhibited_handlers = Vinhibit_file_name_handlers;
  else
    inhibited_handlers = Qnil;
287

288
  for (chain = Vfile_name_handler_alist; CONSP (chain);
289
       chain = XCDR (chain))
290 291
    {
      Lisp_Object elt;
292
      elt = XCAR (chain);
293
      if (CONSP (elt))
294
	{
295
	  Lisp_Object string = XCAR (elt);
296
	  ptrdiff_t match_pos;
297
	  Lisp_Object handler = XCDR (elt);
298 299 300 301
	  Lisp_Object operations = Qnil;

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

303
	  if (STRINGP (string)
304 305
	      && (match_pos = fast_string_match (string, filename)) > pos
	      && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
306
	    {
307
	      Lisp_Object tem;
308

309
	      handler = XCDR (elt);
310 311
	      tem = Fmemq (handler, inhibited_handlers);
	      if (NILP (tem))
312 313 314 315
		{
		  result = handler;
		  pos = match_pos;
		}
316
	    }
317
	}
318 319

      QUIT;
320
    }
321
  return result;
322 323
}

Paul Eggert's avatar
Paul Eggert committed
324
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
325 326 327
       1, 1, 0,
       doc: /* Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
328
Otherwise return a directory name.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
329
Given a Unix syntax file name, returns a string ending in slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
330
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
331
{
332
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
333

334
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
335

336 337
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
338
  handler = Ffind_file_name_handler (filename, Qfile_name_directory);
339
  if (!NILP (handler))
340 341 342 343 344
    {
      Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
345

346 347
  char *beg = SSDATA (filename);
  char const *p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
348

349 350
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
351
	 /* only recognize drive specifier at the beginning */
352 353 354 355
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" and "/:foo" cases correctly  */
	      && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
		  || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
356
#endif
Jim Blandy's avatar
Jim Blandy committed
357 358 359 360
	 ) p--;

  if (p == beg)
    return Qnil;
361
#ifdef DOS_NT
362
  /* Expansion of "c:" to drive and default directory.  */
363 364 365 366 367
  Lisp_Object tem_fn;
  USE_SAFE_ALLOCA;
  SAFE_ALLOCA_STRING (beg, filename);
  p = beg + (p - SSDATA (filename));

368
  if (p[-1] == ':')
369 370
    {
      /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir.  */
371 372
      char *res = alloca (MAXPATHLEN + 1);
      char *r = res;
373 374 375

      if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
	{
376
	  memcpy (res, beg, 2);
377 378 379 380
	  beg += 2;
	  r += 2;
	}

381
      if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
382
	{
383 384 385
	  size_t l = strlen (res);

	  if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
386 387 388
	    strcat (res, "/");
	  beg = res;
	  p = beg + strlen (beg);
389
	  dostounix_filename (beg);
390 391
	  tem_fn = make_specified_string (beg, -1, p - beg,
					  STRING_MULTIBYTE (filename));
392
	}
393 394 395 396 397 398
      else
	tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
					STRING_MULTIBYTE (filename));
    }
  else if (STRING_MULTIBYTE (filename))
    {
399
      tem_fn = make_specified_string (beg, -1, p - beg, 1);
400
      dostounix_filename (SSDATA (tem_fn));
401 402 403 404
#ifdef WINDOWSNT
      if (!NILP (Vw32_downcase_file_names))
	tem_fn = Fdowncase (tem_fn);
#endif
405 406 407
    }
  else
    {
408
      dostounix_filename (beg);
409
      tem_fn = make_specified_string (beg, -1, p - beg, 0);
410
    }
411
  SAFE_FREE ();
412
  return tem_fn;
413
#else  /* DOS_NT */
414
  return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
415
#endif	/* DOS_NT */
Jim Blandy's avatar
Jim Blandy committed
416 417
}

Paul Eggert's avatar
Paul Eggert committed
418
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
419
       Sfile_name_nondirectory, 1, 1, 0,
420 421 422 423
       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
424
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
425
{
426
  register const char *beg, *p, *end;
427
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
428

429
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
430

431 432
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
433
  handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
434
  if (!NILP (handler))
435 436 437 438 439 440 441
    {
      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'");
    }
442

443
  beg = SSDATA (filename);
444
  end = p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
445

446 447
  while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
448
	 /* only recognize drive specifier at beginning */
449 450 451
	 && !(p[-1] == ':'
	      /* handle the "/:d:foo" case correctly  */
	      && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
452
#endif
453 454
	 )
    p--;
Jim Blandy's avatar
Jim Blandy committed
455

456
  return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
Jim Blandy's avatar
Jim Blandy committed
457
}
458

Paul Eggert's avatar
Paul Eggert committed
459
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
460
       Sunhandled_file_name_directory, 1, 1, 0,
461 462 463 464
       doc: /* Return a directly usable directory name somehow associated with FILENAME.
A `directly usable' directory name is one that may be used without the
intervention of any file handler.
If FILENAME is a directly usable file itself, return
465
\(file-name-as-directory FILENAME).
Stefan Monnier's avatar
Stefan Monnier committed
466 467
If FILENAME refers to a file which is not accessible from a local process,
then this should return nil.
468 469
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
470
  (Lisp_Object filename)
471 472 473 474 475
{
  Lisp_Object handler;

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
476
  handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
477
  if (!NILP (handler))
478 479 480 481 482
    {
      Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
					filename);
      return STRINGP (handled_name) ? handled_name : Qnil;
    }
483

484
  return Ffile_name_as_directory (filename);
485 486
}

487 488 489 490
/* 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 };

491 492 493 494
/* 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
495

496
static ptrdiff_t
497 498
file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
			bool multibyte)
499 500
{
  if (srclen == 0)
501
    {
502 503 504 505
      dst[0] = '.';
      dst[1] = '/';
      dst[2] = '\0';
      return 2;
506 507
    }

508
  memcpy (dst, src, srclen);
509
  if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
510 511
    dst[srclen++] = DIRECTORY_SEP;
  dst[srclen] = 0;
512
#ifdef DOS_NT
513
  dostounix_filename (dst);
514
#endif
515
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
516 517
}

Paul Eggert's avatar
Paul Eggert committed
518
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
Jim Blandy's avatar
Jim Blandy committed
519
       Sfile_name_as_directory, 1, 1, 0,
520
       doc: /* Return a string representing the file name FILE interpreted as a directory.
521 522 523 524
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
525 526
For a Unix-syntax file name, just appends a slash unless a trailing slash
is already present.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
527
  (Lisp_Object file)
Jim Blandy's avatar
Jim Blandy committed
528 529
{
  char *buf;
530
  ptrdiff_t length;
531 532
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
533

534
  CHECK_STRING (file);
535 536 537

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
538
  handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
539
  if (!NILP (handler))
540 541 542 543 544 545 546
    {
      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'");
    }
547

548 549 550 551
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    file = Fdowncase (file);
#endif
552
  buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1);
553 554
  length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
				   STRING_MULTIBYTE (file));
555 556 557
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
558 559
}

560 561 562 563
/* 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
564

565
static ptrdiff_t
566
directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
Jim Blandy's avatar
Jim Blandy committed
567 568
{
  /* Process as Unix format: just remove any final slash.
569 570
     But leave "/" and "//" unchanged.  */
  while (srclen > 1
571
#ifdef DOS_NT
572
	 && !IS_ANY_SEP (src[srclen - 2])
573
#endif
574 575 576 577 578 579
	 && IS_DIRECTORY_SEP (src[srclen - 1])
	 && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
    srclen--;

  memcpy (dst, src, srclen);
  dst[srclen] = 0;
580
#ifdef DOS_NT
581
  dostounix_filename (dst);
582
#endif
583
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
584 585
}

Paul Eggert's avatar
Paul Eggert committed
586
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
587 588 589 590 591
       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
592
In Unix-syntax, this function just removes the final slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
593
  (Lisp_Object directory)
Jim Blandy's avatar
Jim Blandy committed
594 595
{
  char *buf;
596
  ptrdiff_t length;
597 598
  Lisp_Object handler, val;
  USE_SAFE_ALLOCA;
Jim Blandy's avatar
Jim Blandy committed
599

600
  CHECK_STRING (directory);
Jim Blandy's avatar
Jim Blandy committed
601

602 603
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
604
  handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
605
  if (!NILP (handler))
606 607 608 609 610 611 612
    {
      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'");
    }
613

614 615 616 617
#ifdef WINDOWSNT
  if (!NILP (Vw32_downcase_file_names))
    directory = Fdowncase (directory);
#endif
618
  buf = SAFE_ALLOCA (SBYTES (directory) + 1);
619 620
  length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
				STRING_MULTIBYTE (directory));
621 622 623
  val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
  SAFE_FREE ();
  return val;
Jim Blandy's avatar
Jim Blandy committed
624 625
}

626
static const char make_temp_name_tbl[64] =
627 628 629 630 631 632 633 634 635 636
{
  'A','B','C','D','E','F','G','H',
  'I','J','K','L','M','N','O','P',
  'Q','R','S','T','U','V','W','X',
  'Y','Z','a','b','c','d','e','f',
  'g','h','i','j','k','l','m','n',
  'o','p','q','r','s','t','u','v',
  'w','x','y','z','0','1','2','3',
  '4','5','6','7','8','9','-','_'
};
637

638 639
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;

640
/* Value is a temporary file name starting with PREFIX, a string.
641

642 643 644 645 646
   The Emacs process number forms part of the result, so there is
   no danger of generating a name being used by another process.
   In addition, this function makes an attempt to choose a name
   which has no existing file.  To make this work, PREFIX should be
   an absolute file name.
647

648
   BASE64_P means add the pid as 3 characters in base64
649 650 651 652 653 654 655 656
   encoding.  In this case, 6 characters will be added to PREFIX to
   form the file name.  Otherwise, if Emacs is running on a system
   with long file names, add the pid as a decimal number.

   This function signals an error if no unique file name could be
   generated.  */

Lisp_Object
657
make_temp_name (Lisp_Object prefix, bool base64_p)
Jim Blandy's avatar
Jim Blandy committed
658
{
659
  Lisp_Object val, encoded_prefix;
660
  ptrdiff_t len;
661
  printmax_t pid;
662
  char *p, *data;
663
  char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
664
  int pidlen;
665

666
  CHECK_STRING (prefix);
667 668 669 670 671 672

  /* VAL is created by adding 6 characters to PREFIX.  The first
     three are the PID of this process, in base 64, and the second
     three are incremented if the file already exists.  This ensures
     262144 unique file names per PID per PREFIX.  */

673
  pid = getpid ();
674

675 676 677 678 679 680 681 682 683
  if (base64_p)
    {
      pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidlen = 3;
    }
  else
    {
684
#ifdef HAVE_LONG_FILE_NAMES
685
      pidlen = sprintf (pidbuf, "%"pMd, pid);
686
#else
687 688 689 690
      pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
      pidlen = 3;
691
#endif
692
    }
693

694 695 696
  encoded_prefix = ENCODE_FILE (prefix);
  len = SBYTES (encoded_prefix);
  val = make_uninit_string (len + 3 + pidlen);
697
  data = SSDATA (val);
698
  memcpy (data, SSDATA (encoded_prefix), len);
699 700
  p = data + len;

701
  memcpy (p, pidbuf, pidlen);
702 703 704 705 706
  p += pidlen;

  /* Here we try to minimize useless stat'ing when this function is
     invoked many times successively with the same PREFIX.  We achieve
     this by initializing count to a random value, and incrementing it
Richard M. Stallman's avatar
Richard M. Stallman committed
707 708 709 710 711 712
     afterwards.

     We don't want make-temp-name to be called while dumping,
     because then make_temp_name_count_initialized_p would get set
     and then make_temp_name_count would not be set when Emacs starts.  */

713 714
  if (!make_temp_name_count_initialized_p)
    {
715
      make_temp_name_count = time (NULL);
716 717 718 719 720
      make_temp_name_count_initialized_p = 1;
    }

  while (1)
    {
721
      unsigned num = make_temp_name_count;
722 723 724 725 726

      p[0] = make_temp_name_tbl[num & 63], num >>= 6;
      p[1] = make_temp_name_tbl[num & 63], num >>= 6;
      p[2] = make_temp_name_tbl[num & 63], num >>= 6;

727 728 729 730 731
      /* Poor man's congruential RN generator.  Replace with
         ++make_temp_name_count for debugging.  */
      make_temp_name_count += 25229;
      make_temp_name_count %= 225307;

732
      if (!check_existing (data))
733 734 735
	{
	  /* We want to return only if errno is ENOENT.  */
	  if (errno == ENOENT)
736
	    return DECODE_FILE (val);
737 738 739 740 741
	  else
	    /* The error here is dubious, but there is little else we
	       can do.  The alternatives are to return nil, which is
	       as bad as (and in many cases worse than) throwing the
	       error, or to ignore the error, which will likely result
742
	       in looping through 225307 stat's, which is not only
743 744
	       dog-slow, but also useless since eventually nil would
	       have to be returned anyway.  */
745
	    report_file_error ("Cannot create temporary name for prefix",
746
			       prefix);
747 748 749
	  /* not reached */
	}
    }
Jim Blandy's avatar
Jim Blandy committed
750
}
751

752 753

DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
754
       doc: /* Generate temporary file name (string) starting with PREFIX (a string).
755 756
The Emacs process number forms part of the result, so there is no
danger of generating a name being used by another Emacs process
757
\(so long as only a single host can access the containing directory...).
758

759 760
This function tries to choose a name that has no existing file.
For this to work, PREFIX should be an absolute file name.
761 762

There is a race condition between calling `make-temp-name' and creating the
763 764
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
765
  (Lisp_Object prefix)
766 767 768 769
{
  return make_temp_name (prefix, 0);
}

Paul Eggert's avatar
Paul Eggert committed
770
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
771 772
       doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
773
\(does not start with slash or tilde); both the directory name and
774 775
a directory's file name are accepted.  If DEFAULT-DIRECTORY is nil or
missing, the current buffer's value of `default-directory' is used.
776 777
NAME should be a string that is a valid file name for the underlying
filesystem.
778 779 780 781
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.
782 783 784
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.)
785 786
An initial `~/' expands to your home directory.
An initial `~USER/' expands to USER's home directory.
Chong Yidong's avatar
Chong Yidong committed
787 788 789 790
See also the function `substitute-in-file-name'.

For technical reasons, this function can return correct but
non-intuitive results for the root directory; for instance,
791 792
\(expand-file-name ".." "/") returns "/..".  For this reason, use
\(directory-file-name (file-name-directory dirname)) to traverse a
Chong Yidong's avatar
Chong Yidong committed
793
filesystem tree, not (expand-file-name ".."  dirname).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
794
  (Lisp_Object name, Lisp_Object default_directory)
Jim Blandy's avatar
Jim Blandy committed
795
{
796 797
  /* These point to SDATA and need to be careful with string-relocation
     during GC (via DECODE_FILE).  */
798
  char *nm;
799
  char *nmlim;
800
  const char *newdir;
801
  const char *newdirlim;
802
  /* This should only point to alloca'd data.  */
803
  char *target;
804

805
  ptrdiff_t tlen;
Jim Blandy's avatar
Jim Blandy committed
806
  struct passwd *pw;
807
#ifdef DOS_NT