X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fa46310344375ef5c114cbb94d4acea39ac29239..e8d32c7e803ad2b790627876bf7afc9381f252c9:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index fb021cee5a..eac7554b17 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,6 +1,6 @@ /* File IO for GNU Emacs. -Copyright (C) 1985-1988, 1993-2011 Free Software Foundation, Inc. +Copyright (C) 1985-1988, 1993-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -87,14 +87,17 @@ along with GNU Emacs. If not, see . */ #define FILE_SYSTEM_CASE(filename) (filename) #endif -/* Nonzero during writing of auto-save files */ +/* Nonzero during writing of auto-save files. */ static int auto_saving; +/* Nonzero umask during creation of auto-save directories. */ +static int auto_saving_dir_umask; + /* Set by auto_save_1 to mode of original file so Fwrite_region will create - a new file with the same mode as the original */ + a new file with the same mode as the original. */ static int auto_save_mode_bits; -/* Set by auto_save_1 if an error occurred during the last auto-save. */ +/* Set by auto_save_1 if an error occurred during the last auto-save. */ static int auto_save_error_occurred; /* The symbol bound to coding-system-for-read when @@ -108,7 +111,7 @@ static Lisp_Object Qauto_save_coding; which gives a list of operations it handles.. */ static Lisp_Object Qoperations; -/* Lisp functions for translating file formats */ +/* Lisp functions for translating file formats. */ static Lisp_Object Qformat_decode, Qformat_annotate_function; /* Lisp function for setting buffer-file-coding-system and the @@ -325,7 +328,11 @@ Given a Unix syntax file name, returns a string ending in slash. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_name_directory); if (!NILP (handler)) - return call2 (handler, Qfile_name_directory, filename); + { + Lisp_Object handled_name = call2 (handler, Qfile_name_directory, + filename); + return STRINGP (handled_name) ? handled_name : Qnil; + } filename = FILE_SYSTEM_CASE (filename); #ifdef DOS_NT @@ -394,7 +401,13 @@ or the entire name if it contains no slash. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory); if (!NILP (handler)) - return call2 (handler, Qfile_name_nondirectory, filename); + { + 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'"); + } beg = SSDATA (filename); end = p = beg + SBYTES (filename); @@ -431,7 +444,11 @@ get a current directory to run processes in. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); if (!NILP (handler)) - return call2 (handler, Qunhandled_file_name_directory, filename); + { + Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory, + filename); + return STRINGP (handled_name) ? handled_name : Qnil; + } return Ffile_name_directory (filename); } @@ -485,7 +502,13 @@ For a Unix-syntax file name, just appends a slash. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (file, Qfile_name_as_directory); if (!NILP (handler)) - return call2 (handler, Qfile_name_as_directory, file); + { + 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'"); + } buf = (char *) alloca (SBYTES (file) + 10); file_name_as_directory (buf, SSDATA (file)); @@ -544,7 +567,13 @@ In Unix-syntax, this function just removes the final slash. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (directory, Qdirectory_file_name); if (!NILP (handler)) - return call2 (handler, Qdirectory_file_name, directory); + { + 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'"); + } buf = (char *) alloca (SBYTES (directory) + 20); directory_file_name (SSDATA (directory), buf); @@ -744,7 +773,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) int is_escaped = 0; #endif /* DOS_NT */ ptrdiff_t length; - Lisp_Object handler, result; + Lisp_Object handler, result, handled_name; int multibyte; Lisp_Object hdir; @@ -754,7 +783,14 @@ filesystem tree, not (expand-file-name ".." dirname). */) call the corresponding file handler. */ handler = Ffind_file_name_handler (name, Qexpand_file_name); if (!NILP (handler)) - return call3 (handler, Qexpand_file_name, name, default_directory); + { + handled_name = call3 (handler, Qexpand_file_name, + name, default_directory); + if (STRINGP (handled_name)) + return handled_name; + error ("Invalid handler in `file-name-handler-alist'"); + } + /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ if (NILP (default_directory)) @@ -780,7 +816,13 @@ filesystem tree, not (expand-file-name ".." dirname). */) { handler = Ffind_file_name_handler (default_directory, Qexpand_file_name); if (!NILP (handler)) - return call3 (handler, Qexpand_file_name, name, default_directory); + { + handled_name = call3 (handler, Qexpand_file_name, + name, default_directory); + if (STRINGP (handled_name)) + return handled_name; + error ("Invalid handler in `file-name-handler-alist'"); + } } { @@ -835,7 +877,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) } } - /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */ + /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */ nm = (char *) alloca (SBYTES (name) + 1); memcpy (nm, SSDATA (name), SBYTES (name) + 1); @@ -863,7 +905,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) nm++; - /* Discard any previous drive specifier if nm is now in UNC format. */ + /* Discard any previous drive specifier if nm is now in UNC format. */ if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) { drive = 0; @@ -928,7 +970,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) } else #endif - /* drive must be set, so this is okay */ + /* Drive must be set, so this is okay. */ if (strcmp (nm - 2, SSDATA (name)) != 0) { char temp[] = " :"; @@ -974,7 +1016,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) if (!(newdir = egetenv ("HOME"))) newdir = ""; nm++; - /* egetenv may return a unibyte string, which will bite us since + /* `egetenv' may return a unibyte string, which will bite us since we expect the directory to be multibyte. */ tem = build_string (newdir); if (!STRING_MULTIBYTE (tem)) @@ -1016,7 +1058,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) use the drive's current directory as the prefix if needed. */ if (!newdir && drive) { - /* Get default directory if needed to make nm absolute. */ + /* Get default directory if needed to make nm absolute. */ char *adir = NULL; if (!IS_DIRECTORY_SEP (nm[0])) { @@ -1026,7 +1068,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) } if (!adir) { - /* Either nm starts with /, or drive isn't mounted. */ + /* Either nm starts with /, or drive isn't mounted. */ adir = alloca (4); adir[0] = DRIVE_LETTER (drive); adir[1] = ':'; @@ -1038,11 +1080,11 @@ filesystem tree, not (expand-file-name ".." dirname). */) #endif /* DOS_NT */ /* Finally, if no prefix has been specified and nm is not absolute, - then it must be expanded relative to default_directory. */ + then it must be expanded relative to default_directory. */ if (1 #ifndef DOS_NT - /* /... alone is not absolute on DOS and Windows. */ + /* /... alone is not absolute on DOS and Windows. */ && !IS_DIRECTORY_SEP (nm[0]) #endif #ifdef WINDOWSNT @@ -1064,7 +1106,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) #ifdef DOS_NT if (newdir) { - /* First ensure newdir is an absolute name. */ + /* First ensure newdir is an absolute name. */ if ( /* Detect MSDOS file names with drive specifiers. */ ! (IS_DRIVE (newdir[0]) @@ -1079,7 +1121,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) Because of the admonition against calling expand-file-name when we have pointers into lisp strings, we accomplish this indirectly by prepending newdir to nm if necessary, and using - cwd (or the wd of newdir's drive) as the new newdir. */ + cwd (or the wd of newdir's drive) as the new newdir. */ char *adir; if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1])) { @@ -1104,7 +1146,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) newdir = adir; } - /* Strip off drive name from prefix, if present. */ + /* Strip off drive name from prefix, if present. */ if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1])) { drive = newdir[0]; @@ -1154,7 +1196,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) else tlen = 0; - /* Now concatenate the directory and name to new space in the stack frame */ + /* Now concatenate the directory and name to new space in the stack frame. */ tlen += strlen (nm) + 1; #ifdef DOS_NT /* Reserve space for drive specifier and escape prefix, since either @@ -1250,7 +1292,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) } #ifdef DOS_NT - /* At last, set drive name. */ + /* At last, set drive name. */ #ifdef WINDOWSNT /* Except for network file name. */ if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]))) @@ -1278,10 +1320,16 @@ filesystem tree, not (expand-file-name ".." dirname). */) and perhaps call the corresponding file handler. This is needed for filenames such as "/foo/../user@host:/bar/../baz". Expanding the ".." component gives us "/user@host:/bar/../baz" which needs - to be expanded again. */ + to be expanded again. */ handler = Ffind_file_name_handler (result, Qexpand_file_name); if (!NILP (handler)) - return call3 (handler, Qexpand_file_name, result, default_directory); + { + handled_name = call3 (handler, Qexpand_file_name, + result, default_directory); + if (STRINGP (handled_name)) + return handled_name; + error ("Invalid handler in `file-name-handler-alist'"); + } return result; } @@ -1348,7 +1396,7 @@ See also the function `substitute-in-file-name'.") } } - /* Now determine directory to start with and put it in NEWDIR */ + /* Now determine directory to start with and put it in NEWDIR. */ newdir = 0; @@ -1361,17 +1409,17 @@ See also the function `substitute-in-file-name'.") } else /* ~user/filename */ { - /* Get past ~ to user */ + /* Get past ~ to user. */ unsigned char *user = nm + 1; - /* Find end of name. */ + /* Find end of name. */ unsigned char *ptr = (unsigned char *) strchr (user, '/'); ptrdiff_t len = ptr ? ptr - user : strlen (user); - /* Copy the user name into temp storage. */ + /* Copy the user name into temp storage. */ o = (unsigned char *) alloca (len + 1); memcpy (o, user, len); o[len] = 0; - /* Look up the user name. */ + /* Look up the user name. */ BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); UNBLOCK_INPUT; @@ -1392,7 +1440,7 @@ See also the function `substitute-in-file-name'.") newdir = SDATA (defalt); } - /* Now concatenate the directory and name to new space in the stack frame */ + /* Now concatenate the directory and name to new space in the stack frame. */ tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1; target = (unsigned char *) alloca (tlen); @@ -1408,7 +1456,7 @@ See also the function `substitute-in-file-name'.") strcat (target, nm); - /* Now canonicalize by removing /. and /foo/.. if they appear */ + /* Now canonicalize by removing /. and /foo/.. if they appear. */ p = target; o = target; @@ -1480,7 +1528,7 @@ search_embedded_absfilename (char *nm, char *endp) ) { for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++); - if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */ + if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */ { char *o = alloca (s - p + 1); struct passwd *pw; @@ -1534,7 +1582,13 @@ those `/' is discarded. */) call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name); if (!NILP (handler)) - return call2 (handler, Qsubstitute_in_file_name, filename); + { + Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name, + filename); + if (STRINGP (handled_name)) + return handled_name; + error ("Invalid handler in `file-name-handler-alist'"); + } /* Always work on a copy of the string, in case GC happens during decode of environment variables, causing the original Lisp_String @@ -1558,7 +1612,7 @@ those `/' is discarded. */) (make_specified_string (p, -1, endp - p, multibyte)); /* See if any variables are substituted into the string - and find the total length of their values in `total' */ + and find the total length of their values in `total'. */ for (p = nm; p != endp;) if (*p != '$') @@ -1570,7 +1624,7 @@ those `/' is discarded. */) goto badsubst; else if (*p == '$') { - /* "$$" means a single "$" */ + /* "$$" means a single "$". */ p++; total -= 1; substituted = 1; @@ -1590,7 +1644,7 @@ those `/' is discarded. */) s = p; } - /* Copy out the variable name */ + /* Copy out the variable name. */ target = (char *) alloca (s - o + 1); strncpy (target, o, s - o); target[s - o] = 0; @@ -1598,7 +1652,7 @@ those `/' is discarded. */) strupr (target); /* $home == $HOME etc. */ #endif /* DOS_NT */ - /* Get variable value */ + /* Get variable value. */ o = egetenv (target); if (o) { @@ -1620,12 +1674,12 @@ those `/' is discarded. */) if (!substituted) return filename; - /* If substitution required, recopy the string and do it */ - /* Make space in stack frame for the new copy */ + /* If substitution required, recopy the string and do it. */ + /* Make space in stack frame for the new copy. */ xnm = (char *) alloca (SBYTES (filename) + total + 1); x = xnm; - /* Copy the rest of the name through, replacing $ constructs with values */ + /* Copy the rest of the name through, replacing $ constructs with values. */ for (p = nm; *p;) if (*p != '$') *x++ = *p++; @@ -1653,7 +1707,7 @@ those `/' is discarded. */) s = p; } - /* Copy out the variable name */ + /* Copy out the variable name. */ target = (char *) alloca (s - o + 1); strncpy (target, o, s - o); target[s - o] = 0; @@ -1661,7 +1715,7 @@ those `/' is discarded. */) strupr (target); /* $home == $HOME etc. */ #endif /* DOS_NT */ - /* Get variable value */ + /* Get variable value. */ o = egetenv (target); if (!o) { @@ -1723,7 +1777,7 @@ expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) stat behaves differently depending! */ if (SCHARS (absname) > 1 && IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1)) - && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2))) + && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2))) /* We cannot take shortcuts; they might be wrong for magic file names. */ absname = Fdirectory_file_name (absname); return absname; @@ -1751,7 +1805,7 @@ barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring, encoded_filename = ENCODE_FILE (absname); - /* stat is a good way to tell whether the file exists, + /* `stat' is a good way to tell whether the file exists, regardless of what access permissions it has. */ if (lstat (SSDATA (encoded_filename), &statbuf) >= 0) { @@ -1990,9 +2044,10 @@ on the system, we copy the SELinux context of FILE to NEWNAME. */) #if HAVE_LIBSELINUX if (conlength > 0) { - /* Set the modified context back to the file. */ + /* Set the modified context back to the file. */ fail = fsetfilecon (ofd, con); - if (fail) + /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ + if (fail && errno != ENOTSUP) report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil)); freecon (con); @@ -2062,7 +2117,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, #ifdef WINDOWSNT if (mkdir (dir) != 0) #else - if (mkdir (dir, 0777) != 0) + if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0) #endif report_file_error ("Creating directory", list1 (directory)); @@ -2416,15 +2471,27 @@ check_writable (const char *filename) return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode)); #else /* not MSDOS */ #ifdef HAVE_EUIDACCESS - return (euidaccess (filename, 2) >= 0); -#else + int res = (euidaccess (filename, 2) >= 0); +#ifdef CYGWIN + /* euidaccess may have returned failure because Cygwin couldn't + determine the file's UID or GID; if so, we return success. */ + if (!res) + { + struct stat st; + if (stat (filename, &st) < 0) + return 0; + res = (st.st_uid == -1 || st.st_gid == -1); + } +#endif /* CYGWIN */ + return res; +#else /* not HAVE_EUIDACCESS */ /* Access isn't quite right because it uses the real uid and we really want to test with the effective uid. But Unix doesn't give us a right way to do it. Opening with O_WRONLY could work for an ordinary file, but would lose for directories. */ return (access (filename, 2) >= 0); -#endif +#endif /* not HAVE_EUIDACCESS */ #endif /* not MSDOS */ } @@ -2732,9 +2799,13 @@ See `file-symlink-p' to distinguish symlinks. */) DEFUN ("file-selinux-context", Ffile_selinux_context, Sfile_selinux_context, 1, 1, 0, - doc: /* Return SELinux context of file named FILENAME, -as a list ("user", "role", "type", "range"). Return (nil, nil, nil, nil) -if file does not exist, is not accessible, or SELinux is disabled */) + doc: /* Return SELinux context of file named FILENAME. +The return value is a list (USER ROLE TYPE RANGE), where the list +elements are strings naming the user, role, type, and range of the +file's SELinux security context. + +Return (nil nil nil nil) if the file is nonexistent or inaccessible, +or if SELinux is disabled, or if Emacs lacks SELinux support. */) (Lisp_Object filename) { Lisp_Object absname; @@ -2787,9 +2858,12 @@ if file does not exist, is not accessible, or SELinux is disabled */) DEFUN ("set-file-selinux-context", Fset_file_selinux_context, Sset_file_selinux_context, 2, 2, 0, - doc: /* Set SELinux context of file named FILENAME to CONTEXT -as a list ("user", "role", "type", "range"). Has no effect if SELinux -is disabled. */) + doc: /* Set SELinux context of file named FILENAME to CONTEXT. +CONTEXT should be a list (USER ROLE TYPE RANGE), where the list +elements are strings naming the components of a SELinux context. + +This function does nothing if SELinux is disabled, or if Emacs was not +compiled with SELinux support. */) (Lisp_Object filename, Lisp_Object context) { Lisp_Object absname; @@ -2844,10 +2918,11 @@ is disabled. */) error ("Doing context_range_set"); } - /* Set the modified context back to the file. */ + /* Set the modified context back to the file. */ fail = lsetfilecon (SSDATA (encoded_absname), context_str (parsed_con)); - if (fail) + /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ + if (fail && errno != ENOTSUP) report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil)); context_free (parsed_con); @@ -5193,16 +5268,18 @@ do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */ static Lisp_Object do_auto_save_make_dir (Lisp_Object dir) { - Lisp_Object mode; + Lisp_Object result; - call2 (Qmake_directory, dir, Qt); - XSETFASTINT (mode, 0700); - return Fset_file_modes (dir, mode); + auto_saving_dir_umask = 077; + result = call2 (Qmake_directory, dir, Qt); + auto_saving_dir_umask = 0; + return result; } static Lisp_Object do_auto_save_eh (Lisp_Object ignore) { + auto_saving_dir_umask = 0; return Qnil; } @@ -5270,7 +5347,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) dir = Ffile_name_directory (listfile); if (NILP (Ffile_directory_p (dir))) internal_condition_case_1 (do_auto_save_make_dir, - dir, Fcons (Fcons (Qfile_error, Qnil), Qnil), + dir, Qt, do_auto_save_eh); UNGCPRO; } @@ -5536,7 +5613,7 @@ syms_of_fileio (void) DEFSYM (Qexcl, "excl"); DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, - doc: /* *Coding system for encoding file names. + doc: /* Coding system for encoding file names. If it is nil, `default-file-name-coding-system' (which see) is used. */); Vfile_name_coding_system = Qnil; @@ -5572,18 +5649,25 @@ of file names regardless of the current language environment. */); make_pure_c_string ("Cannot set file date")); DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, - doc: /* *Alist of elements (REGEXP . HANDLER) for file names handled specially. -If a file name matches REGEXP, then all I/O on that file is done by calling -HANDLER. - -The first argument given to HANDLER is the name of the I/O primitive -to be handled; the remaining arguments are the arguments that were -passed to that primitive. For example, if you do - (file-exists-p FILENAME) -and FILENAME is handled by HANDLER, then HANDLER is called like this: - (funcall HANDLER 'file-exists-p FILENAME) -The function `find-file-name-handler' checks this list for a handler -for its argument. */); + doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. +If a file name matches REGEXP, all I/O on that file is done by calling +HANDLER. If a file name matches more than one handler, the handler +whose match starts last in the file name gets precedence. The +function `find-file-name-handler' checks this list for a handler for +its argument. + +HANDLER should be a function. The first argument given to it is the +name of the I/O primitive to be handled; the remaining arguments are +the arguments that were passed to that primitive. For example, if you +do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then +HANDLER is called like this: + + (funcall HANDLER 'file-exists-p FILENAME) + +Note that HANDLER must be able to handle all I/O primitives; if it has +nothing special to do for a primitive, it should reinvoke the +primitive to handle the operation \"the usual way\". +See Info node `(elisp)Magic File Names' for more details. */); Vfile_name_handler_alist = Qnil; DEFVAR_LISP ("set-auto-coding-function", @@ -5683,7 +5767,7 @@ file is usually more useful if it contains the deleted text. */); #ifdef HAVE_FSYNC DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync, - doc: /* *Non-nil means don't call fsync in `write-region'. + doc: /* Non-nil means don't call fsync in `write-region'. This variable affects calls to `write-region' as well as save commands. A non-nil value may result in data loss! */); write_region_inhibit_fsync = 0;