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

3
Copyright (C) 1985-1988, 1993-2013 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 <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
24 25
#include <sys/types.h>
#include <sys/stat.h>
26 27
#include <unistd.h>

28
#ifdef HAVE_PWD_H
Jim Blandy's avatar
Jim Blandy committed
29
#include <pwd.h>
Jim Blandy's avatar
Jim Blandy committed
30 31
#endif

Jim Blandy's avatar
Jim Blandy committed
32 33
#include <errno.h>

Karel Klíc's avatar
Karel Klíc committed
34 35 36 37 38
#ifdef HAVE_LIBSELINUX
#include <selinux/selinux.h>
#include <selinux/context.h>
#endif

39 40 41 42
#ifdef HAVE_POSIX_ACL
#include <sys/acl.h>
#endif

43 44
#include <c-ctype.h>

Jim Blandy's avatar
Jim Blandy committed
45
#include "lisp.h"
46
#include "intervals.h"
47
#include "character.h"
48
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
49
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
50
#include "window.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
51
#include "blockinput.h"
Karoly Lorentey's avatar
Karoly Lorentey committed
52 53
#include "frame.h"
#include "dispextern.h"
Jim Blandy's avatar
Jim Blandy committed
54

55 56 57 58
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
#include <fcntl.h>
59
#include <sys/file.h>
60
#include "w32.h"
61 62
#endif /* not WINDOWSNT */

Eli Zaretskii's avatar
Eli Zaretskii committed
63 64 65 66 67 68
#ifdef MSDOS
#include "msdos.h"
#include <sys/param.h>
#include <fcntl.h>
#endif

69 70
#ifdef DOS_NT
/* On Windows, drive letters must be alphabetic - on DOS, the Netware
71
   redirector allows the six letters between 'Z' and 'a' as well.  */
72 73 74 75
#ifdef MSDOS
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
76
#define IS_DRIVE(x) c_isalpha (x)
77
#endif
78
/* Need to lower-case the drive letter, or else expanded
Paul Eggert's avatar
Paul Eggert committed
79
   filenames will sometimes compare unequal, because
80
   `expand-file-name' doesn't always down-case the drive letter.  */
81
#define DRIVE_LETTER(x) c_tolower (x)
82 83
#endif

Jim Blandy's avatar
Jim Blandy committed
84
#include "systime.h"
85
#include <stat-time.h>
Jim Blandy's avatar
Jim Blandy committed
86 87 88

#ifdef HPUX
#include <netio.h>
89
#endif
Jim Blandy's avatar
Jim Blandy committed
90

91 92
#include "commands.h"

93 94
/* True during writing of auto-save files.  */
static bool auto_saving;
Jim Blandy's avatar
Jim Blandy committed
95

96
/* Nonzero umask during creation of auto-save directories.  */
97
static mode_t auto_saving_dir_umask;
98

Jim Blandy's avatar
Jim Blandy committed
99
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
100
   a new file with the same mode as the original.  */
101
static mode_t auto_save_mode_bits;
Jim Blandy's avatar
Jim Blandy committed
102

103
/* Set by auto_save_1 if an error occurred during the last auto-save.  */
104
static bool auto_save_error_occurred;
105

106 107 108 109 110
/* 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;

111 112 113 114 115
/* The symbol bound to coding-system-for-read when
   insert-file-contents is called for recovering a file.  This is not
   an actual coding system name, but just an indicator to tell
   insert-file-contents to use `emacs-mule' with a special flag for
   auto saving and recovering a file.  */
116
static Lisp_Object Qauto_save_coding;
117

118 119
/* Property name of a file name handler,
   which gives a list of operations it handles..  */
120
static Lisp_Object Qoperations;
121

122
/* Lisp functions for translating file formats.  */
123
static Lisp_Object Qformat_decode, Qformat_annotate_function;
124

125
/* Lisp function for setting buffer-file-coding-system and the
126
   multibyteness of the current buffer after inserting a file.  */
127
static Lisp_Object Qafter_insert_file_set_coding;
128

129
static Lisp_Object Qwrite_region_annotate_functions;
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
#ifdef HAVE_FSYNC
#endif

137
static Lisp_Object Qdelete_by_moving_to_trash;
138

139
/* Lisp function for moving files to trash.  */
140
static Lisp_Object Qmove_file_to_trash;
141

142
/* Lisp function for recursively copying directories.  */
143
static Lisp_Object Qcopy_directory;
144 145

/* Lisp function for recursively deleting directories.  */
146
static Lisp_Object Qdelete_directory;
147

148 149 150
#ifdef WINDOWSNT
#endif

151 152 153
Lisp_Object Qfile_error;
static Lisp_Object Qfile_already_exists, Qfile_date_error;
static Lisp_Object Qexcl;
154 155
Lisp_Object Qfile_name_history;

156
static Lisp_Object Qcar_less_than_car;
157

158 159 160 161
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 *);
162

163

164
void
165
report_file_error (const char *string, Lisp_Object data)
Jim Blandy's avatar
Jim Blandy committed
166 167
{
  Lisp_Object errstring;
Richard M. Stallman's avatar
Richard M. Stallman committed
168
  int errorno = errno;
169
  char *str;
Jim Blandy's avatar
Jim Blandy committed
170

171
  synchronize_system_messages_locale ();
172
  str = strerror (errorno);
173
  errstring = code_convert_string_norecord (build_unibyte_string (str),
174 175
					    Vlocale_coding_system, 0);

Jim Blandy's avatar
Jim Blandy committed
176
  while (1)
Richard M. Stallman's avatar
Richard M. Stallman committed
177 178 179
    switch (errorno)
      {
      case EEXIST:
180
	xsignal (Qfile_already_exists, Fcons (errstring, data));
Richard M. Stallman's avatar
Richard M. Stallman committed
181 182 183
	break;
      default:
	/* System error messages are capitalized.  Downcase the initial
184 185
	   unless it is followed by a slash.  (The slash case caters to
	   error messages that begin with "I/O" or, in German, "E/A".)  */
186 187
	if (STRING_MULTIBYTE (errstring)
	    && ! EQ (Faref (errstring, make_number (1)), make_number ('/')))
188 189 190
	  {
	    int c;

191
	    str = SSDATA (errstring);
192
	    c = STRING_CHAR ((unsigned char *) str);
193
	    Faset (errstring, make_number (0), make_number (downcase (c)));
194
	  }
Richard M. Stallman's avatar
Richard M. Stallman committed
195

196
	xsignal (Qfile_error,
Richard M. Stallman's avatar
Richard M. Stallman committed
197 198
		 Fcons (build_string (string), Fcons (errstring, data)));
      }
Jim Blandy's avatar
Jim Blandy committed
199
}
200

201
Lisp_Object
202
close_file_unwind (Lisp_Object fd)
203
{
204
  emacs_close (XFASTINT (fd));
205
  return Qnil;
206
}
207 208 209

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

Andreas Schwab's avatar
Andreas Schwab committed
210
Lisp_Object
211
restore_point_unwind (Lisp_Object location)
212
{
213
  Fgoto_char (location);
214
  Fset_marker (location, Qnil, Qnil);
215
  return Qnil;
216
}
217

Jim Blandy's avatar
Jim Blandy committed
218

219 220 221 222 223 224 225 226 227 228 229
static Lisp_Object Qexpand_file_name;
static Lisp_Object Qsubstitute_in_file_name;
static Lisp_Object Qdirectory_file_name;
static Lisp_Object Qfile_name_directory;
static Lisp_Object Qfile_name_nondirectory;
static Lisp_Object Qunhandled_file_name_directory;
static Lisp_Object Qfile_name_as_directory;
static Lisp_Object Qcopy_file;
static Lisp_Object Qmake_directory_internal;
static Lisp_Object Qmake_directory;
static Lisp_Object Qdelete_directory_internal;
230
Lisp_Object Qdelete_file;
231 232 233
static Lisp_Object Qrename_file;
static Lisp_Object Qadd_name_to_file;
static Lisp_Object Qmake_symbolic_link;
234
Lisp_Object Qfile_exists_p;
235 236 237 238 239
static Lisp_Object Qfile_executable_p;
static Lisp_Object Qfile_readable_p;
static Lisp_Object Qfile_writable_p;
static Lisp_Object Qfile_symlink_p;
static Lisp_Object Qaccess_file;
240
Lisp_Object Qfile_directory_p;
241 242 243 244 245 246 247
static Lisp_Object Qfile_regular_p;
static Lisp_Object Qfile_accessible_directory_p;
static Lisp_Object Qfile_modes;
static Lisp_Object Qset_file_modes;
static Lisp_Object Qset_file_times;
static Lisp_Object Qfile_selinux_context;
static Lisp_Object Qset_file_selinux_context;
248 249
static Lisp_Object Qfile_acl;
static Lisp_Object Qset_file_acl;
250
static Lisp_Object Qfile_newer_than_file_p;
251 252
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
253 254
static Lisp_Object Qverify_visited_file_modtime;
static Lisp_Object Qset_visited_file_modtime;
255

Paul Eggert's avatar
Paul Eggert committed
256
DEFUN ("find-file-name-handler", Ffind_file_name_handler,
257
       Sfind_file_name_handler, 2, 2, 0,
258 259 260 261 262 263 264 265 266
       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
267
  (Lisp_Object filename, Lisp_Object operation)
268
{
269
  /* This function must not munge the match data.  */
270
  Lisp_Object chain, inhibited_handlers, result;
271
  ptrdiff_t pos = -1;
272

273
  result = Qnil;
274
  CHECK_STRING (filename);
275

276 277 278 279
  if (EQ (operation, Vinhibit_file_name_operation))
    inhibited_handlers = Vinhibit_file_name_handlers;
  else
    inhibited_handlers = Qnil;
280

281
  for (chain = Vfile_name_handler_alist; CONSP (chain);
282
       chain = XCDR (chain))
283 284
    {
      Lisp_Object elt;
285
      elt = XCAR (chain);
286
      if (CONSP (elt))
287
	{
288
	  Lisp_Object string = XCAR (elt);
289
	  ptrdiff_t match_pos;
290
	  Lisp_Object handler = XCDR (elt);
291 292 293 294
	  Lisp_Object operations = Qnil;

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

296
	  if (STRINGP (string)
297 298
	      && (match_pos = fast_string_match (string, filename)) > pos
	      && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
299
	    {
300
	      Lisp_Object tem;
301

302
	      handler = XCDR (elt);
303 304
	      tem = Fmemq (handler, inhibited_handlers);
	      if (NILP (tem))
305 306 307 308
		{
		  result = handler;
		  pos = match_pos;
		}
309
	    }
310
	}
311 312

      QUIT;
313
    }
314
  return result;
315 316
}

Paul Eggert's avatar
Paul Eggert committed
317
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
318 319 320
       1, 1, 0,
       doc: /* Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
321
Otherwise return a directory name.
Dan Nicolaescu's avatar
Dan Nicolaescu committed
322
Given a Unix syntax file name, returns a string ending in slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
323
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
324
{
325
#ifndef DOS_NT
326
  register const char *beg;
327
#else
328
  register char *beg;
329
  Lisp_Object tem_fn;
330
#endif
331
  register const char *p;
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
#ifdef DOS_NT
347
  beg = alloca (SBYTES (filename) + 1);
348
  memcpy (beg, SSDATA (filename), SBYTES (filename) + 1);
349
#else
350
  beg = SSDATA (filename);
351
#endif
352
  p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
353

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

  if (p == beg)
    return Qnil;
366
#ifdef DOS_NT
367
  /* Expansion of "c:" to drive and default directory.  */
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
	  if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
384 385 386
	    strcat (res, "/");
	  beg = res;
	  p = beg + strlen (beg);
387 388 389
	  dostounix_filename (beg);
	  tem_fn = make_specified_string (beg, -1, p - beg,
					  STRING_MULTIBYTE (filename));
390
	}
391 392 393 394 395 396 397 398 399 400 401 402 403 404
      else
	tem_fn = make_specified_string (beg - 2, -1, p - beg + 2,
					STRING_MULTIBYTE (filename));
    }
  else if (STRING_MULTIBYTE (filename))
    {
      tem_fn = ENCODE_FILE (make_specified_string (beg, -1, p - beg, 1));
      dostounix_filename (SSDATA (tem_fn));
      tem_fn = DECODE_FILE (tem_fn);
    }
  else
    {
      dostounix_filename (beg);
      tem_fn = make_specified_string (beg, -1, p - beg, 0);
405
    }
406
  return tem_fn;
407
#else  /* DOS_NT */
408
  return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
409
#endif	/* DOS_NT */
Jim Blandy's avatar
Jim Blandy committed
410 411
}

Paul Eggert's avatar
Paul Eggert committed
412
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
413
       Sfile_name_nondirectory, 1, 1, 0,
414 415 416 417
       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
418
  (Lisp_Object filename)
Jim Blandy's avatar
Jim Blandy committed
419
{
420
  register const char *beg, *p, *end;
421
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
422

423
  CHECK_STRING (filename);
Jim Blandy's avatar
Jim Blandy committed
424

425 426
  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
427
  handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
428
  if (!NILP (handler))
429 430 431 432 433 434 435
    {
      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'");
    }
436

437
  beg = SSDATA (filename);
438
  end = p = beg + SBYTES (filename);
Jim Blandy's avatar
Jim Blandy committed
439

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

450
  return make_specified_string (p, -1, end - p, STRING_MULTIBYTE (filename));
Jim Blandy's avatar
Jim Blandy committed
451
}
452

Paul Eggert's avatar
Paul Eggert committed
453
DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
454
       Sunhandled_file_name_directory, 1, 1, 0,
455 456 457 458 459
       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
\(file-name-directory FILENAME).
Stefan Monnier's avatar
Stefan Monnier committed
460 461
If FILENAME refers to a file which is not accessible from a local process,
then this should return nil.
462 463
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
464
  (Lisp_Object filename)
465 466 467 468 469
{
  Lisp_Object handler;

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

  return Ffile_name_directory (filename);
}

481 482 483 484
/* 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
485

486
static ptrdiff_t
487 488
file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen,
			bool multibyte)
489 490
{
  if (srclen == 0)
491
    {
492 493 494 495
      dst[0] = '.';
      dst[1] = '/';
      dst[2] = '\0';
      return 2;
496 497
    }

498
  strcpy (dst, src);
499

500
  if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
501
    {
502 503 504
      dst[srclen] = DIRECTORY_SEP;
      dst[srclen + 1] = '\0';
      srclen++;
505
    }
506
#ifdef DOS_NT
507 508 509
  if (multibyte)
    {
      Lisp_Object tem_fn = make_specified_string (dst, -1, srclen, 1);
510

511 512 513 514 515 516 517
      tem_fn = ENCODE_FILE (tem_fn);
      dostounix_filename (SSDATA (tem_fn));
      tem_fn = DECODE_FILE (tem_fn);
      memcpy (dst, SSDATA (tem_fn), (srclen = SBYTES (tem_fn)) + 1);
    }
  else
    dostounix_filename (dst);
518
#endif
519
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
520 521
}

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

536
  CHECK_STRING (file);
Jim Blandy's avatar
Jim Blandy committed
537
  if (NILP (file))
Jim Blandy's avatar
Jim Blandy committed
538
    return Qnil;
539 540 541

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

552
  buf = alloca (SBYTES (file) + 10);
553 554
  length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
				   STRING_MULTIBYTE (file));
555
  return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
Jim Blandy's avatar
Jim Blandy committed
556 557
}

558 559 560 561
/* 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
562

563
static ptrdiff_t
564
directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
Jim Blandy's avatar
Jim Blandy committed
565 566 567 568
{
  /* Process as Unix format: just remove any final slash.
     But leave "/" unchanged; do not change it to "".  */
  strcpy (dst, src);
569 570
  if (srclen > 1
      && IS_DIRECTORY_SEP (dst[srclen - 1])
571
#ifdef DOS_NT
572
      && !IS_ANY_SEP (dst[srclen - 2])
573 574
#endif
      )
575 576 577 578
    {
      dst[srclen - 1] = 0;
      srclen--;
    }
579
#ifdef DOS_NT
580 581 582
  if (multibyte)
    {
      Lisp_Object tem_fn = make_specified_string (dst, -1, srclen, 1);
583

584 585 586 587 588 589 590
      tem_fn = ENCODE_FILE (tem_fn);
      dostounix_filename (SSDATA (tem_fn));
      tem_fn = DECODE_FILE (tem_fn);
      memcpy (dst, SSDATA (tem_fn), (srclen = SBYTES (tem_fn)) + 1);
    }
  else
    dostounix_filename (dst);
591
#endif
592
  return srclen;
Jim Blandy's avatar
Jim Blandy committed
593 594
}

Paul Eggert's avatar
Paul Eggert committed
595
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
596 597 598 599 600
       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
601
In Unix-syntax, this function just removes the final slash.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
602
  (Lisp_Object directory)
Jim Blandy's avatar
Jim Blandy committed
603 604
{
  char *buf;
605
  ptrdiff_t length;
606
  Lisp_Object handler;
Jim Blandy's avatar
Jim Blandy committed
607

608
  CHECK_STRING (directory);
Jim Blandy's avatar
Jim Blandy committed
609

Jim Blandy's avatar
Jim Blandy committed
610
  if (NILP (directory))
Jim Blandy's avatar
Jim Blandy committed
611
    return Qnil;
612 613 614

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
615
  handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
616
  if (!NILP (handler))
617 618 619 620 621 622 623
    {
      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'");
    }
624

625
  buf = alloca (SBYTES (directory) + 20);
626 627
  length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
				STRING_MULTIBYTE (directory));
628
  return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
Jim Blandy's avatar
Jim Blandy committed
629 630
}

631
static const char make_temp_name_tbl[64] =
632 633 634 635 636 637 638 639 640 641
{
  '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','-','_'
};
642

643 644
static unsigned make_temp_name_count, make_temp_name_count_initialized_p;

645
/* Value is a temporary file name starting with PREFIX, a string.
646

647 648 649 650 651
   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.
652

653
   BASE64_P means add the pid as 3 characters in base64
654 655 656 657 658 659 660 661
   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
662
make_temp_name (Lisp_Object prefix, bool base64_p)
Jim Blandy's avatar
Jim Blandy committed
663 664
{
  Lisp_Object val;
665
  int len, clen;
666
  printmax_t pid;
667
  char *p, *data;
668
  char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
669
  int pidlen;
670

671
  CHECK_STRING (prefix);
672 673 674 675 676 677

  /* 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.  */

678
  pid = getpid ();
679

680 681 682 683 684 685 686 687 688
  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
    {
689
#ifdef HAVE_LONG_FILE_NAMES
690
      pidlen = sprintf (pidbuf, "%"pMd, pid);
691
#else
692 693 694 695
      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;
696
#endif
697
    }
698

699 700 701 702
  len = SBYTES (prefix); clen = SCHARS (prefix);
  val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
  if (!STRING_MULTIBYTE (prefix))
    STRING_SET_UNIBYTE (val);
703 704
  data = SSDATA (val);
  memcpy (data, SSDATA (prefix), len);
705 706
  p = data + len;

707
  memcpy (p, pidbuf, pidlen);
708 709 710 711 712
  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
713 714 715 716 717 718
     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.  */

719 720
  if (!make_temp_name_count_initialized_p)
    {
721
      make_temp_name_count = time (NULL);
722 723 724 725 726
      make_temp_name_count_initialized_p = 1;
    }

  while (1)
    {
727
      unsigned num = make_temp_name_count;
728 729 730 731 732

      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;

733 734 735 736 737
      /* Poor man's congruential RN generator.  Replace with
         ++make_temp_name_count for debugging.  */
      make_temp_name_count += 25229;
      make_temp_name_count %= 225307;

738
      if (!check_existing (data))
739 740 741 742 743 744 745 746 747
	{
	  /* We want to return only if errno is ENOENT.  */
	  if (errno == ENOENT)
	    return val;
	  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
748
	       in looping through 225307 stat's, which is not only
749 750
	       dog-slow, but also useless since eventually nil would
	       have to be returned anyway.  */
751
	    report_file_error ("Cannot create temporary name for prefix",
752 753 754 755
			       Fcons (prefix, Qnil));
	  /* not reached */
	}
    }
Jim Blandy's avatar
Jim Blandy committed
756
}
757

758 759

DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
760 761 762 763 764 765 766 767 768 769
       doc: /* Generate temporary file name (string) starting with PREFIX (a string).
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.

There is a race condition between calling `make-temp-name' and creating the
file which opens all kinds of security holes.  For that reason, you should
770 771 772 773 774
probably use `make-temp-file' instead, except in three circumstances:

* If you are creating the file in the user's home directory.
* If you are creating a directory rather than an ordinary file.
* If you are taking special precautions as `make-temp-file' does.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
775
  (Lisp_Object prefix)
776 777 778 779 780
{
  return make_temp_name (prefix, 0);
}


Jim Blandy's avatar
Jim Blandy committed
781

Paul Eggert's avatar
Paul Eggert committed
782
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
783 784
       doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
785
\(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,