1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2023 Free Software
3 Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 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/>. */
19
20
21 #include <config.h>
22
23 #include <sys/stat.h>
24
25 #ifdef HAVE_PWD_H
26 #include <pwd.h>
27 #endif
28 #include <grp.h>
29
30 #include <errno.h>
31 #include <fcntl.h>
32 #include <unistd.h>
33
34 #include <dirent.h>
35 #include <filemode.h>
36 #include <stat-time.h>
37
38 #include "lisp.h"
39 #include "systime.h"
40 #include "buffer.h"
41 #include "coding.h"
42
43 #ifdef MSDOS
44 #include "msdos.h" /* for fstatat */
45 #endif
46
47 #if !(defined HAVE_ANDROID && !defined ANDROID_STUBIFY)
48 typedef DIR emacs_dir;
49 #define emacs_readdir readdir
50 #define emacs_closedir closedir
51 #else
52
53 #include "android.h"
54
55 /* The Android emulation of dirent stuff is required to be able to
56 list the /assets special directory. */
57 typedef struct android_vdir emacs_dir;
58 #define emacs_readdir android_readdir
59 #define emacs_closedir android_closedir
60 #endif
61
62 #ifdef WINDOWSNT
63 extern int is_slow_fs (const char *);
64 #endif
65
66 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
67 static Lisp_Object file_attributes (int, char const *, Lisp_Object,
68 Lisp_Object, Lisp_Object);
69
70 /* Return the number of bytes in DP's name. */
71 static ptrdiff_t
72 dirent_namelen (struct dirent *dp)
73 {
74 #ifdef _D_EXACT_NAMLEN
75 return _D_EXACT_NAMLEN (dp);
76 #else
77 return strlen (dp->d_name);
78 #endif
79 }
80
81 #ifndef HAVE_STRUCT_DIRENT_D_TYPE
82 enum { DT_UNKNOWN, DT_DIR, DT_LNK };
83 #endif
84
85 /* Return the file type of DP. */
86 static int
87 dirent_type (struct dirent *dp)
88 {
89 #ifdef HAVE_STRUCT_DIRENT_D_TYPE
90 return dp->d_type;
91 #else
92 return DT_UNKNOWN;
93 #endif
94 }
95
96 static emacs_dir *
97 open_directory (Lisp_Object dirname, Lisp_Object encoded_dirname, int *fdp)
98 {
99 char *name = SSDATA (encoded_dirname);
100 emacs_dir *d;
101 int fd, opendir_errno;
102
103 #if defined DOS_NT || (defined HAVE_ANDROID && !defined ANDROID_STUBIFY)
104 /* On DOS_NT, directories cannot be opened. The emulation assumes
105 that any file descriptor other than AT_FDCWD corresponds to the
106 most recently opened directory. This hack is good enough for
107 Emacs.
108
109 This code is also used on Android for a different reason: a
110 special `assets' directory outside the normal file system is used
111 to open assets inside the Android application package, and must
112 be listed using the opendir-like interface provided in
113 android.h. */
114 fd = 0;
115 #ifndef HAVE_ANDROID
116 d = opendir (name);
117 #else
118 /* `android_opendir' can return EINTR if DIRNAME designates a file
119 within a slow-to-respond document provider. */
120
121 again:
122 d = android_opendir (name);
123
124 if (d)
125 fd = android_dirfd (d);
126 else if (errno == EINTR)
127 {
128 maybe_quit ();
129 goto again;
130 }
131 #endif
132 opendir_errno = errno;
133 #else
134 fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
135 if (fd < 0)
136 {
137 opendir_errno = errno;
138 d = 0;
139 }
140 else
141 {
142 d = fdopendir (fd);
143 opendir_errno = errno;
144 if (! d)
145 emacs_close (fd);
146 }
147 #endif
148
149 if (!d)
150 report_file_errno ("Opening directory", dirname, opendir_errno);
151 *fdp = fd;
152 return d;
153 }
154
155 #ifdef WINDOWSNT
156 static void
157 directory_files_internal_w32_unwind (Lisp_Object arg)
158 {
159 Vw32_get_true_file_attributes = arg;
160 }
161 #endif
162
163 static void
164 directory_files_internal_unwind (void *d)
165 {
166 emacs_closedir (d);
167 }
168
169 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
170 If there are no more directory entries, return a null pointer.
171 Signal any unrecoverable errors. */
172
173 static struct dirent *
174 read_dirent (emacs_dir *dir, Lisp_Object dirname)
175 {
176 while (true)
177 {
178 errno = 0;
179 struct dirent *dp = emacs_readdir (dir);
180 if (dp || errno == 0)
181 return dp;
182 if (! (errno == EAGAIN || errno == EINTR))
183 {
184 #ifdef WINDOWSNT
185 /* The MS-Windows implementation of 'opendir' doesn't
186 actually open a directory until the first call to
187 'readdir'. If 'readdir' fails to open the directory, it
188 sets errno to ENOENT or EACCES, see w32.c. */
189 if (errno == ENOENT || errno == EACCES)
190 report_file_error ("Opening directory", dirname);
191 #endif
192 report_file_error ("Reading directory", dirname);
193 }
194 maybe_quit ();
195 }
196 }
197
198 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
199 If not ATTRS, return a list of directory filenames;
200 if ATTRS, return a list of directory filenames and their attributes.
201 In the latter case, pass ID_FORMAT to file_attributes. */
202
203 Lisp_Object
204 directory_files_internal (Lisp_Object directory, Lisp_Object full,
205 Lisp_Object match, Lisp_Object nosort, bool attrs,
206 Lisp_Object id_format, Lisp_Object return_count)
207 {
208 EMACS_INT ind = 0, last = MOST_POSITIVE_FIXNUM;
209
210 if (!NILP (return_count))
211 {
212 CHECK_FIXNAT (return_count);
213 last = XFIXNAT (return_count);
214 }
215
216 if (!NILP (match))
217 CHECK_STRING (match);
218
219 /* Don't let the compiler optimize away all copies of DIRECTORY,
220 which would break GC; see Bug#16986. */
221 Lisp_Object volatile directory_volatile = directory;
222
223 Lisp_Object dirfilename = Fdirectory_file_name (directory);
224
225 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
226 run_pre_post_conversion_on_str which calls Lisp directly and
227 indirectly. */
228 Lisp_Object encoded_dirfilename = ENCODE_FILE (dirfilename);
229
230 int fd;
231
232 /* Keep in mind that FD is not always a real file descriptor on
233 Android. */
234 emacs_dir *d = open_directory (dirfilename, encoded_dirfilename, &fd);
235
236 /* Unfortunately, we can now invoke expand-file-name and
237 file-attributes on filenames, both of which can throw, so we must
238 do a proper unwind-protect. */
239 specpdl_ref count = SPECPDL_INDEX ();
240 record_unwind_protect_ptr (directory_files_internal_unwind, d);
241
242 #ifdef WINDOWSNT
243 Lisp_Object w32_save = Qnil;
244 if (attrs)
245 {
246 /* Do this only once to avoid doing it (in w32.c:stat) for each
247 file in the directory, when we call file_attributes below. */
248 record_unwind_protect (directory_files_internal_w32_unwind,
249 Vw32_get_true_file_attributes);
250 w32_save = Vw32_get_true_file_attributes;
251 if (EQ (Vw32_get_true_file_attributes, Qlocal))
252 {
253 /* w32.c:stat will notice these bindings and avoid calling
254 GetDriveType for each file. */
255 if (is_slow_fs (SSDATA (encoded_dirfilename)))
256 Vw32_get_true_file_attributes = Qnil;
257 else
258 Vw32_get_true_file_attributes = Qt;
259 }
260 }
261 #endif
262
263 if (!NILP (full) && !STRING_MULTIBYTE (directory))
264 { /* We will be concatenating 'directory' with local file name.
265 We always decode local file names, so in order to safely concatenate
266 them we need 'directory' to be decoded as well (bug#56469). */
267 directory = DECODE_FILE (directory);
268 }
269
270 ptrdiff_t directory_nbytes = SBYTES (directory);
271 re_match_object = Qt;
272
273 /* Decide whether we need to add a directory separator. */
274 bool needsep = (directory_nbytes == 0
275 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)));
276
277 /* Windows users want case-insensitive wildcards. */
278 Lisp_Object case_table = Qnil;
279 #ifdef WINDOWSNT
280 case_table = BVAR (&buffer_defaults, case_canon_table);
281 #endif
282
283 /* Read directory entries and accumulate them into LIST. */
284 Lisp_Object list = Qnil;
285 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
286 {
287 ptrdiff_t len = dirent_namelen (dp);
288 Lisp_Object name = make_unibyte_string (dp->d_name, len);
289 Lisp_Object finalname = name;
290
291 /* This can GC. */
292 name = DECODE_FILE (name);
293
294 maybe_quit ();
295
296 if (!NILP (match)
297 && fast_string_match_internal (match, name, case_table) < 0)
298 continue;
299
300 Lisp_Object fileattrs UNINIT;
301 if (attrs)
302 {
303 fileattrs = file_attributes (fd, dp->d_name, directory, name,
304 id_format);
305 if (NILP (fileattrs))
306 continue;
307 }
308
309 if (!NILP (full))
310 {
311 ptrdiff_t name_nbytes = SBYTES (name);
312 ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes;
313 ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name);
314 /* DECODE_FILE may return non-ASCII unibyte strings (e.g. when
315 file-name-coding-system is 'binary'), so we don't know for sure
316 that the bytes we have follow our internal utf-8 representation
317 for multibyte strings. If nchars == nbytes we don't need to
318 care and just return a unibyte string; and if not, that means
319 one of 'name' or 'directory' is multibyte, in which case we
320 presume that the other one would also be multibyte if it
321 contained non-ASCII.
322 FIXME: This last presumption is broken when 'directory' is
323 multibyte (with non-ASCII), and 'name' is unibyte with non-ASCII
324 (because file-name-coding-system is 'binary'). */
325 finalname = (nchars == nbytes)
326 ? make_uninit_string (nbytes)
327 : make_uninit_multibyte_string (nchars, nbytes);
328 memcpy (SDATA (finalname), SDATA (directory), directory_nbytes);
329 if (needsep)
330 SSET (finalname, directory_nbytes, DIRECTORY_SEP);
331 memcpy (SDATA (finalname) + directory_nbytes + needsep,
332 SDATA (name), name_nbytes);
333 }
334 else
335 finalname = name;
336
337 if (ind == last)
338 break;
339 ind ++;
340
341 list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list);
342 }
343
344 emacs_closedir (d);
345 #ifdef WINDOWSNT
346 if (attrs)
347 Vw32_get_true_file_attributes = w32_save;
348 #endif
349
350 /* Discard the unwind protect. */
351 specpdl_ptr = specpdl_ref_to_ptr (count);
352
353 if (NILP (nosort))
354 list = Fsort (Fnreverse (list),
355 attrs ? Qfile_attributes_lessp : Qstring_lessp);
356
357 (void) directory_volatile;
358 return list;
359 }
360
361
362 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 5, 0,
363 doc: /* Return a list of names of files in DIRECTORY.
364 There are four optional arguments:
365 If FULL is non-nil, return absolute file names. Otherwise return names
366 that are relative to the specified directory.
367 If MATCH is non-nil, mention only file names whose non-directory part
368 matches the regexp MATCH.
369 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
370 Otherwise, the list returned is sorted with `string-lessp'.
371 NOSORT is useful if you plan to sort the result yourself.
372 If COUNT is non-nil and a natural number, the function will return
373 COUNT number of file names (if so many are present). */)
374 (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
375 Lisp_Object nosort, Lisp_Object count)
376 {
377 directory = Fexpand_file_name (directory, Qnil);
378
379 /* If the file name has special constructs in it,
380 call the corresponding file name handler. */
381 Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files);
382 if (!NILP (handler))
383 return call6 (handler, Qdirectory_files, directory,
384 full, match, nosort, count);
385
386 return directory_files_internal (directory, full, match, nosort,
387 false, Qnil, count);
388 }
389
390 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
391 Sdirectory_files_and_attributes, 1, 6, 0,
392 doc: /* Return a list of names of files and their attributes in DIRECTORY.
393 Value is a list of the form:
394
395 ((FILE1 . FILE1-ATTRS) (FILE2 . FILE2-ATTRS) ...)
396
397 where each FILEn-ATTRS is the attributes of FILEn as returned
398 by `file-attributes'.
399
400 This function accepts five optional arguments:
401 If FULL is non-nil, return absolute file names. Otherwise return names
402 that are relative to the specified directory.
403 If MATCH is non-nil, mention only file names whose non-directory part
404 matches the regexp MATCH.
405 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
406 NOSORT is useful if you plan to sort the result yourself.
407 ID-FORMAT specifies the preferred format of attributes uid and gid, see
408 `file-attributes' for further documentation.
409 If COUNT is non-nil and a natural number, the function will return
410 COUNT number of file names (if so many are present).
411 On MS-Windows, performance depends on `w32-get-true-file-attributes',
412 which see. */)
413 (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
414 Lisp_Object nosort, Lisp_Object id_format, Lisp_Object count)
415 {
416 directory = Fexpand_file_name (directory, Qnil);
417
418 /* If the file name has special constructs in it,
419 call the corresponding file name handler. */
420 Lisp_Object handler
421 = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
422 if (!NILP (handler))
423 return call7 (handler, Qdirectory_files_and_attributes,
424 directory, full, match, nosort, id_format, count);
425
426 return directory_files_internal (directory, full, match, nosort,
427 true, id_format, count);
428 }
429
430
431 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
432 Lisp_Object);
433
434 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
435 2, 3, 0,
436 doc: /* Complete file name FILE in directory DIRECTORY.
437 Returns the longest string
438 common to all file names in DIRECTORY that start with FILE.
439 If there is only one and FILE matches it exactly, returns t.
440 Returns nil if DIRECTORY contains no name starting with FILE.
441
442 If PREDICATE is non-nil, call PREDICATE with each possible
443 completion (in absolute form) and ignore it if PREDICATE returns nil.
444
445 This function ignores some of the possible completions as determined
446 by the variables `completion-regexp-list' and
447 `completion-ignored-extensions', which see. `completion-regexp-list'
448 is matched against file and directory names relative to DIRECTORY. */)
449 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
450 {
451 Lisp_Object handler;
452 directory = Fexpand_file_name (directory, Qnil);
453
454 /* If the directory name has special constructs in it,
455 call the corresponding file name handler. */
456 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
457 if (!NILP (handler))
458 return call4 (handler, Qfile_name_completion, file, directory, predicate);
459
460 /* If the file name has special constructs in it,
461 call the corresponding file name handler. */
462 handler = Ffind_file_name_handler (file, Qfile_name_completion);
463 if (!NILP (handler))
464 return call4 (handler, Qfile_name_completion, file, directory, predicate);
465
466 return file_name_completion (file, directory, 0, predicate);
467 }
468
469 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
470 Sfile_name_all_completions, 2, 2, 0,
471 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
472 These are all file names in directory DIRECTORY which begin with FILE.
473
474 This function ignores some of the possible completions as determined
475 by `completion-regexp-list', which see. `completion-regexp-list'
476 is matched against file and directory names relative to DIRECTORY. */)
477 (Lisp_Object file, Lisp_Object directory)
478 {
479 Lisp_Object handler;
480 directory = Fexpand_file_name (directory, Qnil);
481
482 /* If the directory name has special constructs in it,
483 call the corresponding file name handler. */
484 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
485 if (!NILP (handler))
486 return call3 (handler, Qfile_name_all_completions, file, directory);
487
488 /* If the file name has special constructs in it,
489 call the corresponding file name handler. */
490 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
491 if (!NILP (handler))
492 return call3 (handler, Qfile_name_all_completions, file, directory);
493
494 return file_name_completion (file, directory, 1, Qnil);
495 }
496
497 static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t);
498
499 static Lisp_Object
500 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
501 Lisp_Object predicate)
502 {
503 ptrdiff_t bestmatchsize = 0;
504 int matchcount = 0;
505 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
506 If ALL_FLAG is 0, BESTMATCH is either nil
507 or the best match so far, not decoded. */
508 Lisp_Object bestmatch, tem, elt, name;
509 Lisp_Object encoded_file;
510 Lisp_Object encoded_dir;
511 bool directoryp;
512 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
513 well as "." and "..". Until shown otherwise, assume we can't exclude
514 anything. */
515 bool includeall = 1;
516 bool check_decoded = false;
517 specpdl_ref count = SPECPDL_INDEX ();
518
519 elt = Qnil;
520
521 CHECK_STRING (file);
522
523 bestmatch = Qnil;
524 encoded_file = encoded_dir = Qnil;
525 specbind (Qdefault_directory, dirname);
526
527 /* Do completion on the encoded file name
528 because the other names in the directory are (we presume)
529 encoded likewise. We decode the completed string at the end. */
530 /* Actually, this is not quite true any more: we do most of the completion
531 work with decoded file names, but we still do some filtering based
532 on the encoded file name. */
533 encoded_file = ENCODE_FILE (file);
534 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
535
536 Lisp_Object file_encoding = Vfile_name_coding_system;
537 if (NILP (Vfile_name_coding_system))
538 file_encoding = Vdefault_file_name_coding_system;
539 /* If the file-name encoding decomposes characters, as we do for
540 HFS+ filesystems, we need to make an additional comparison of
541 decoded names in order to filter false positives, such as "a"
542 falsely matching "a-ring". */
543 if (!NILP (file_encoding)
544 && !NILP (plist_get (Fcoding_system_plist (file_encoding),
545 Qdecomposed_characters)))
546 {
547 check_decoded = true;
548 if (STRING_MULTIBYTE (file))
549 {
550 /* Recompute FILE to make sure any decomposed characters in
551 it are re-composed by the post-read-conversion.
552 Otherwise, any decomposed characters will be rejected by
553 the additional check below. */
554 file = DECODE_FILE (encoded_file);
555 }
556 }
557 int fd;
558 emacs_dir *d = open_directory (dirname, encoded_dir, &fd);
559 record_unwind_protect_ptr (directory_files_internal_unwind, d);
560
561 /* Loop reading directory entries. */
562 Lisp_Object zero = make_fixnum (0);
563 ptrdiff_t enc_file_len = SCHARS (encoded_file);
564 Lisp_Object file_len = make_fixnum (SCHARS (file));
565 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
566 {
567 ptrdiff_t len = dirent_namelen (dp);
568 bool canexclude = 0;
569
570 maybe_quit ();
571
572 if (len < enc_file_len
573 /* scmp cannot reliably compare non-ASCII strings while
574 ignoring letter-case. */
575 || (!completion_ignore_case
576 && scmp (dp->d_name, SSDATA (encoded_file), enc_file_len) >= 0))
577 continue;
578
579 name = make_unibyte_string (dp->d_name, len);
580 name = DECODE_FILE (name);
581 ptrdiff_t name_blen = SBYTES (name), name_len = SCHARS (name);
582 if (completion_ignore_case
583 && !BASE_EQ (Fcompare_strings (name, zero, file_len, file, zero,
584 file_len, Qt),
585 Qt))
586 continue;
587
588 switch (dirent_type (dp))
589 {
590 case DT_DIR:
591 directoryp = true;
592 break;
593
594 case DT_LNK: case DT_UNKNOWN:
595 directoryp = file_name_completion_dirp (fd, dp, len);
596 break;
597
598 default:
599 directoryp = false;
600 break;
601 }
602
603 tem = Qnil;
604 /* If all_flag is set, always include all.
605 It would not actually be helpful to the user to ignore any possible
606 completions when making a list of them. */
607 if (!all_flag)
608 {
609 ptrdiff_t skip;
610 Lisp_Object cmp_len = make_fixnum (name_len);
611
612 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
613 /* If this entry matches the current bestmatch, the only
614 thing it can do is increase matchcount, so don't bother
615 investigating it any further. */
616 if (!completion_ignore_case
617 /* The return result depends on whether it's the sole match. */
618 && matchcount > 1
619 && !includeall /* This match may allow includeall to 0. */
620 && len >= bestmatchsize
621 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
622 continue;
623 #endif
624
625 if (directoryp)
626 {
627 #ifndef TRIVIAL_DIRECTORY_ENTRY
628 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
629 #endif
630 /* "." and ".." are never interesting as completions, and are
631 actually in the way in a directory with only one file. */
632 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
633 canexclude = 1;
634 else if (len > enc_file_len)
635 /* Ignore directories if they match an element of
636 completion-ignored-extensions which ends in a slash. */
637 for (tem = Vcompletion_ignored_extensions;
638 CONSP (tem); tem = XCDR (tem))
639 {
640 ptrdiff_t elt_len;
641 char *p1;
642
643 elt = XCAR (tem);
644 if (!STRINGP (elt))
645 continue;
646 elt_len = SBYTES (elt) - 1; /* -1 for trailing / */
647 if (elt_len <= 0)
648 continue;
649 p1 = SSDATA (elt);
650 if (p1[elt_len] != '/')
651 continue;
652 skip = name_blen - elt_len;
653 if (skip < 0)
654 continue;
655
656 if (!completion_ignore_case
657 && scmp (SSDATA (name) + skip, p1, elt_len) >= 0)
658 continue;
659 if (completion_ignore_case)
660 {
661 elt_len = SCHARS (elt) - 1;
662 skip = name_len - elt_len;
663 cmp_len = make_fixnum (elt_len);
664 if (skip < 0
665 || !BASE_EQ (Fcompare_strings (name,
666 make_fixnum (skip),
667 Qnil,
668 elt, zero, cmp_len,
669 Qt),
670 Qt))
671 continue;
672 }
673 break;
674 }
675 }
676 else
677 {
678 /* Compare extensions-to-be-ignored against end of this file name */
679 /* if name is not an exact match against specified string */
680 if (len > enc_file_len)
681 /* and exit this for loop if a match is found */
682 for (tem = Vcompletion_ignored_extensions;
683 CONSP (tem); tem = XCDR (tem))
684 {
685 elt = XCAR (tem);
686 if (!STRINGP (elt)) continue;
687 ptrdiff_t elt_len = SBYTES (elt);
688 skip = len - elt_len;
689 if (skip < 0) continue;
690
691 if (!completion_ignore_case
692 && (scmp (SSDATA (name) + skip, SSDATA (elt), elt_len)
693 >= 0))
694 continue;
695 if (completion_ignore_case)
696 {
697 elt_len = SCHARS (elt);
698 skip = name_len - elt_len;
699 cmp_len = make_fixnum (elt_len);
700 if (skip < 0
701 || !BASE_EQ (Fcompare_strings (name,
702 make_fixnum (skip),
703 Qnil,
704 elt, zero, cmp_len,
705 Qt),
706 Qt))
707 continue;
708 }
709 break;
710 }
711 }
712
713 /* If an ignored-extensions match was found,
714 don't process this name as a completion. */
715 if (CONSP (tem))
716 canexclude = 1;
717
718 if (!includeall && canexclude)
719 /* We're not including all files and this file can be excluded. */
720 continue;
721
722 if (includeall && !canexclude)
723 { /* If we have one non-excludable file, we want to exclude the
724 excludable files. */
725 includeall = 0;
726 /* Throw away any previous excludable match found. */
727 bestmatch = Qnil;
728 bestmatchsize = 0;
729 matchcount = 0;
730 }
731 }
732
733 Lisp_Object regexps, table = (completion_ignore_case
734 ? Vascii_canon_table : Qnil);
735
736 /* Ignore this element if it fails to match all the regexps. */
737 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
738 regexps = XCDR (regexps))
739 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
740 break;
741
742 if (CONSP (regexps))
743 continue;
744
745 /* This is a possible completion */
746 if (directoryp)
747 /* This completion is a directory; make it end with '/'. */
748 name = Ffile_name_as_directory (name);
749
750 /* Test the predicate, if any. */
751 if (!NILP (predicate) && NILP (call1 (predicate, name)))
752 continue;
753
754 /* Reject entries where the encoded strings match, but the
755 decoded don't. For example, "a" should not match "a-ring" on
756 file systems that store decomposed characters. */
757 if (check_decoded && SCHARS (file) <= SCHARS (name))
758 {
759 /* FIXME: This is a copy of the code below. */
760 ptrdiff_t compare = SCHARS (file);
761 Lisp_Object cmp
762 = Fcompare_strings (name, zero, make_fixnum (compare),
763 file, zero, make_fixnum (compare),
764 completion_ignore_case ? Qt : Qnil);
765 if (!BASE_EQ (cmp, Qt))
766 continue;
767 }
768
769 /* Suitably record this match. */
770
771 matchcount += matchcount <= 1;
772
773 if (all_flag)
774 bestmatch = Fcons (name, bestmatch);
775 else if (NILP (bestmatch))
776 {
777 bestmatch = name;
778 bestmatchsize = SCHARS (name);
779 }
780 else
781 {
782 /* FIXME: This is a copy of the code in Ftry_completion. */
783 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
784 Lisp_Object cmp
785 = Fcompare_strings (bestmatch, zero, make_fixnum (compare),
786 name, zero, make_fixnum (compare),
787 completion_ignore_case ? Qt : Qnil);
788 ptrdiff_t matchsize = BASE_EQ (cmp, Qt)
789 ? compare : eabs (XFIXNUM (cmp)) - 1;
790
791 if (completion_ignore_case)
792 {
793 /* If this is an exact match except for case,
794 use it as the best match rather than one that is not
795 an exact match. This way, we get the case pattern
796 of the actual match. */
797 /* This tests that the current file is an exact match
798 but BESTMATCH is not (it is too long). */
799 if ((matchsize == SCHARS (name)
800 && matchsize + directoryp < SCHARS (bestmatch))
801 ||
802 /* If there is no exact match ignoring case,
803 prefer a match that does not change the case
804 of the input. */
805 /* If there is more than one exact match aside from
806 case, and one of them is exact including case,
807 prefer that one. */
808 /* This == checks that, of current file and BESTMATCH,
809 either both or neither are exact. */
810 (((matchsize == SCHARS (name))
811 ==
812 (matchsize + directoryp == SCHARS (bestmatch)))
813 && (cmp = Fcompare_strings (name, zero,
814 make_fixnum (SCHARS (file)),
815 file, zero,
816 Qnil,
817 Qnil),
818 BASE_EQ (Qt, cmp))
819 && (cmp = Fcompare_strings (bestmatch, zero,
820 make_fixnum (SCHARS (file)),
821 file, zero,
822 Qnil,
823 Qnil),
824 ! BASE_EQ (Qt, cmp))))
825 bestmatch = name;
826 }
827 bestmatchsize = matchsize;
828
829 /* If the best completion so far is reduced to the string
830 we're trying to complete, then we already know there's no
831 other completion, so there's no point looking any further. */
832 if (matchsize <= SCHARS (file)
833 && !includeall /* A future match may allow includeall to 0. */
834 /* If completion-ignore-case is non-nil, don't
835 short-circuit because we want to find the best
836 possible match *including* case differences. */
837 && (!completion_ignore_case || matchsize == 0)
838 /* The return value depends on whether it's the sole match. */
839 && matchcount > 1)
840 break;
841
842 }
843 }
844
845 /* This closes the directory. */
846 bestmatch = unbind_to (count, bestmatch);
847
848 if (all_flag || NILP (bestmatch))
849 return bestmatch;
850 /* Return t if the supplied string is an exact match (counting case);
851 it does not require any change to be made. */
852 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
853 return Qt;
854 bestmatch = Fsubstring (bestmatch, make_fixnum (0),
855 make_fixnum (bestmatchsize));
856 return bestmatch;
857 }
858
859 /* Compare exactly LEN chars of strings at S1 and S2,
860 ignoring case if appropriate.
861 Return -1 if strings match,
862 else number of chars that match at the beginning. */
863
864 static ptrdiff_t
865 scmp (const char *s1, const char *s2, ptrdiff_t len)
866 {
867 register ptrdiff_t l = len;
868
869 if (completion_ignore_case)
870 {
871 /* WARNING: This only works for pure ASCII strings, as we
872 compare bytes, not characters! Use Fcompare_strings for
873 comparing non-ASCII strings case-insensitively. */
874 while (l
875 && (downcase ((unsigned char) *s1++)
876 == downcase ((unsigned char) *s2++)))
877 l--;
878 }
879 else
880 {
881 while (l && *s1++ == *s2++)
882 l--;
883 }
884 if (l == 0)
885 return -1;
886 else
887 return len - l;
888 }
889
890 /* Return true if in the directory FD the directory entry DP, whose
891 string length is LEN, is that of a subdirectory that can be searched. */
892 static bool
893 file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len)
894 {
895 USE_SAFE_ALLOCA;
896 char *subdir_name = SAFE_ALLOCA (len + 2);
897 memcpy (subdir_name, dp->d_name, len);
898 strcpy (subdir_name + len, "/");
899
900 bool dirp = sys_faccessat (fd, subdir_name,
901 F_OK, AT_EACCESS) == 0;
902 SAFE_FREE ();
903 return dirp;
904 }
905
906 static char *
907 stat_uname (struct stat *st)
908 {
909 #ifdef WINDOWSNT
910 return st->st_uname;
911 #else
912 struct passwd *pw = getpwuid (st->st_uid);
913
914 if (pw)
915 return pw->pw_name;
916 else
917 return NULL;
918 #endif
919 }
920
921 static char *
922 stat_gname (struct stat *st)
923 {
924 #ifdef WINDOWSNT
925 return st->st_gname;
926 #else
927 struct group *gr = getgrgid (st->st_gid);
928
929 if (gr)
930 return gr->gr_name;
931 else
932 return NULL;
933 #endif
934 }
935
936 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
937 doc: /* Return a list of attributes of file FILENAME.
938 Value is nil if specified file does not exist.
939
940 ID-FORMAT specifies the preferred format of attributes uid and gid (see
941 below) - valid values are `string' and `integer'. The latter is the
942 default, but we plan to change that, so you should specify a non-nil value
943 for ID-FORMAT if you use the returned uid or gid.
944
945 To access the elements returned, the following access functions are
946 provided: `file-attribute-type', `file-attribute-link-number',
947 `file-attribute-user-id', `file-attribute-group-id',
948 `file-attribute-access-time', `file-attribute-modification-time',
949 `file-attribute-status-change-time', `file-attribute-size',
950 `file-attribute-modes', `file-attribute-inode-number', and
951 `file-attribute-device-number'.
952
953 Elements of the attribute list are:
954 0. t for directory, string (name linked to) for symbolic link, or nil.
955 1. Number of links to file.
956 2. File uid as a string or (if ID-FORMAT is `integer' or a string value
957 cannot be looked up) as an integer.
958 3. File gid, likewise.
959 4. Last access time, in the style of `current-time'.
960 (See a note below about access time on FAT-based filesystems.)
961 5. Last modification time, likewise. This is the time of the last
962 change to the file's contents.
963 6. Last status change time, likewise. This is the time of last change
964 to the file's attributes: owner and group, access mode bits, etc.
965 7. Size in bytes, as an integer.
966 8. File modes, as a string of ten letters or dashes as in ls -l.
967 9. An unspecified value, present only for backward compatibility.
968 10. inode number, as a nonnegative integer.
969 11. Filesystem device identifier, as an integer or a cons cell of integers.
970
971 Large integers are bignums, so `eq' might not work on them.
972 On most filesystems, the combination of the inode and the device
973 identifier uniquely identifies the file. This unique file identification
974 is provided by the access function `file-attribute-file-identifier'.
975
976 On MS-Windows, performance depends on `w32-get-true-file-attributes',
977 which see.
978
979 On some FAT-based filesystems, only the date of last access is recorded,
980 so last access time will always be midnight of that day. */)
981 (Lisp_Object filename, Lisp_Object id_format)
982 {
983 Lisp_Object encoded;
984 Lisp_Object handler;
985
986 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
987 Qt, Fidentity);
988 if (!STRINGP (filename))
989 return Qnil;
990
991 /* If the file name has special constructs in it,
992 call the corresponding file name handler. */
993 handler = Ffind_file_name_handler (filename, Qfile_attributes);
994 if (!NILP (handler))
995 { /* Only pass the extra arg if it is used to help backward
996 compatibility with old file name handlers which do not
997 implement the new arg. --Stef */
998 if (NILP (id_format))
999 return call2 (handler, Qfile_attributes, filename);
1000 else
1001 return call3 (handler, Qfile_attributes, filename, id_format);
1002 }
1003
1004 encoded = ENCODE_FILE (filename);
1005 return file_attributes (AT_FDCWD, SSDATA (encoded), Qnil, filename,
1006 id_format);
1007 }
1008
1009 static Lisp_Object
1010 file_attributes (int fd, char const *name,
1011 Lisp_Object dirname, Lisp_Object filename,
1012 Lisp_Object id_format)
1013 {
1014 specpdl_ref count = SPECPDL_INDEX ();
1015 struct stat s;
1016
1017 /* An array to hold the mode string generated by filemodestring,
1018 including its terminating space and null byte. */
1019 char modes[sizeof "-rwxr-xr-x "];
1020
1021 char *uname = NULL, *gname = NULL;
1022
1023 int err = EINVAL;
1024
1025 #if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG \
1026 && !(defined HAVE_ANDROID && !defined ANDROID_STUBIFY)
1027 int namefd = emacs_openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW, 0);
1028 if (namefd < 0)
1029 err = errno;
1030 else
1031 {
1032 record_unwind_protect_int (close_file_unwind, namefd);
1033 if (sys_fstat (namefd, &s) != 0)
1034 {
1035 err = errno;
1036 /* The Linux kernel before version 3.6 does not support
1037 fstat on O_PATH file descriptors. Handle this error like
1038 missing support for O_PATH. */
1039 if (err == EBADF)
1040 err = EINVAL;
1041 }
1042 else
1043 {
1044 err = 0;
1045 fd = namefd;
1046 name = "";
1047 }
1048 }
1049 #endif
1050
1051 if (err == EINVAL)
1052 {
1053 #ifdef WINDOWSNT
1054 /* We usually don't request accurate owner and group info,
1055 because it can be expensive on Windows to get that, and most
1056 callers of 'lstat' don't need that. But here we do want that
1057 information to be accurate. */
1058 w32_stat_get_owner_group = 1;
1059 #endif
1060 err = emacs_fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno;
1061 #ifdef WINDOWSNT
1062 w32_stat_get_owner_group = 0;
1063 #endif
1064 }
1065
1066 if (err != 0)
1067 return unbind_to (count, file_attribute_errno (filename, err));
1068
1069 Lisp_Object file_type;
1070 if (S_ISLNK (s.st_mode))
1071 {
1072 /* On systems lacking O_PATH support there is a race if the
1073 symlink is replaced between the call to fstatat and the call
1074 to emacs_readlinkat. Detect this race unless the replacement
1075 is also a symlink. */
1076 file_type = check_emacs_readlinkat (fd, filename, name);
1077 if (NILP (file_type))
1078 return unbind_to (count, Qnil);
1079 }
1080 else
1081 file_type = S_ISDIR (s.st_mode) ? Qt : Qnil;
1082
1083 unbind_to (count, Qnil);
1084
1085 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
1086 {
1087 uname = stat_uname (&s);
1088 gname = stat_gname (&s);
1089 }
1090
1091 filemodestring (&s, modes);
1092
1093 return CALLN (Flist,
1094 file_type,
1095 make_fixnum (s.st_nlink),
1096 (uname
1097 ? DECODE_SYSTEM (build_unibyte_string (uname))
1098 : INT_TO_INTEGER (s.st_uid)),
1099 (gname
1100 ? DECODE_SYSTEM (build_unibyte_string (gname))
1101 : INT_TO_INTEGER (s.st_gid)),
1102 make_lisp_time (get_stat_atime (&s)),
1103 make_lisp_time (get_stat_mtime (&s)),
1104 make_lisp_time (get_stat_ctime (&s)),
1105
1106 /* If the file size is a 4-byte type, assume that
1107 files of sizes in the 2-4 GiB range wrap around to
1108 negative values, as this is a common bug on older
1109 32-bit platforms. */
1110 INT_TO_INTEGER (sizeof (s.st_size) == 4
1111 ? s.st_size & 0xffffffffu
1112 : s.st_size),
1113
1114 make_string (modes, 10),
1115 Qt,
1116 INT_TO_INTEGER (s.st_ino),
1117 INT_TO_INTEGER (s.st_dev));
1118 }
1119
1120 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp,
1121 Sfile_attributes_lessp, 2, 2, 0,
1122 doc: /* Return t if first arg file attributes list is less than second.
1123 Comparison is in lexicographic order and case is significant. */)
1124 (Lisp_Object f1, Lisp_Object f2)
1125 {
1126 return Fstring_lessp (Fcar (f1), Fcar (f2));
1127 }
1128
1129
1130 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
1131 doc: /* Return a list of user names currently registered in the system.
1132 If we don't know how to determine that on this platform, just
1133 return a list with one element, taken from `user-real-login-name'. */)
1134 (void)
1135 {
1136 Lisp_Object users = Qnil;
1137 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1138 struct passwd *pw;
1139
1140 while ((pw = getpwent ()))
1141 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1142
1143 endpwent ();
1144 #endif
1145 if (NILP (users))
1146 /* At least current user is always known. */
1147 users = list1 (Vuser_real_login_name);
1148 return users;
1149 }
1150
1151 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1152 doc: /* Return a list of user group names currently registered in the system.
1153 The value may be nil if not supported on this platform. */)
1154 (void)
1155 {
1156 Lisp_Object groups = Qnil;
1157 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1158 struct group *gr;
1159
1160 while ((gr = getgrent ()))
1161 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1162
1163 endgrent ();
1164 #endif
1165 return groups;
1166 }
1167
1168 void
1169 syms_of_dired (void)
1170 {
1171 DEFSYM (Qdirectory_files, "directory-files");
1172 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1173 DEFSYM (Qfile_name_completion, "file-name-completion");
1174 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1175 DEFSYM (Qfile_attributes, "file-attributes");
1176 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1177 DEFSYM (Qdefault_directory, "default-directory");
1178 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1179
1180 defsubr (&Sdirectory_files);
1181 defsubr (&Sdirectory_files_and_attributes);
1182 defsubr (&Sfile_name_completion);
1183 defsubr (&Sfile_name_all_completions);
1184 defsubr (&Sfile_attributes);
1185 defsubr (&Sfile_attributes_lessp);
1186 defsubr (&Ssystem_users);
1187 defsubr (&Ssystem_groups);
1188
1189 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1190 doc: /* Completion ignores file names ending in any string in this list.
1191 It does not ignore them if all possible completions end in one of
1192 these strings or when displaying a list of completions.
1193 It ignores directory names if they match any string in this list which
1194 ends in a slash. */);
1195 Vcompletion_ignored_extensions = Qnil;
1196 }