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