Esempio n. 1
0
void
lock_file (Lisp_Object fn)
{
  register Lisp_Object attack, orig_fn, encoded_fn;
  register char *lfname, *locker;
  lock_info_type lock_info;
  struct gcpro gcpro1;

  /* Don't do locking while dumping Emacs.
     Uncompressing wtmp files uses call-process, which does not work
     in an uninitialized Emacs.  */
  if (! NILP (Vpurify_flag))
    return;

  orig_fn = fn;
  GCPRO1 (fn);
  fn = Fexpand_file_name (fn, Qnil);
  encoded_fn = ENCODE_FILE (fn);

  /* Create the name of the lock-file for file fn */
  MAKE_LOCK_NAME (lfname, encoded_fn);

  /* See if this file is visited and has changed on disk since it was
     visited.  */
  {
    register Lisp_Object subject_buf;

    subject_buf = get_truename_buffer (orig_fn);

    if (!NILP (subject_buf)
	&& NILP (Fverify_visited_file_modtime (subject_buf))
	&& !NILP (Ffile_exists_p (fn)))
      call1 (intern ("ask-user-about-supersession-threat"), fn);

  }
  UNGCPRO;

  /* Try to lock the lock. */
  if (lock_if_free (&lock_info, lfname) <= 0)
    /* Return now if we have locked it, or if lock creation failed */
    return;

  /* Else consider breaking the lock */
  locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
			    + LOCK_PID_MAX + 9);
  sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
           lock_info.pid);
  FREE_LOCK_INFO (lock_info);

  attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
  if (!NILP (attack))
    /* User says take the lock */
    {
      lock_file_1 (lfname, 1);
      return;
    }
  /* User says ignore the lock */
}
Esempio n. 2
0
void
unlock_file (register Lisp_Object fn)
{
  register char *lfname;

  fn = Fexpand_file_name (fn, Qnil);
  fn = ENCODE_FILE (fn);

  MAKE_LOCK_NAME (lfname, fn);

  if (current_lock_owner (0, lfname) == 2)
    unlink (lfname);
}
Esempio n. 3
0
static void
chdir_to_default_directory (void)
{
  Lisp_Object new_cwd;
  int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);

  if (old_cwd_fd == -1)
    error ("could not open current directory: %s", strerror (errno));

  record_unwind_protect_int (fchdir_unwind, old_cwd_fd);

  new_cwd = Funhandled_file_name_directory (
    Fexpand_file_name (build_string ("."), Qnil));
  if (!STRINGP (new_cwd))
    new_cwd = build_string ("/");

  if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
    error ("could not chdir: %s", strerror (errno));
}
Esempio n. 4
0
DESCRIPTOR is the same object as the one returned by this function.
ACTIONS is a list of events.

FILE is the name of the file whose event is being reported.  FILE1
will be reported only in case of the `rename' event.  This is possible
only when the upper directory of the renamed file is watched.  */)
  (Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
{
  Lisp_Object watch_object, dir_list;
  int fd, oflags;
  u_short fflags = 0;
  struct kevent kev;

  /* Check parameters.  */
  CHECK_STRING (file);
  file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
  if (NILP (Ffile_exists_p (file)))
    report_file_error ("File does not exist", file);

  CHECK_LIST (flags);

  if (! FUNCTIONP (callback))
    wrong_type_argument (Qinvalid_function, callback);

  if (kqueuefd < 0)
    {
      /* Create kqueue descriptor.  */
      kqueuefd = kqueue ();
      if (kqueuefd < 0)
	report_file_notify_error ("File watching is not available", Qnil);
Esempio n. 5
0
File: dired.c Progetto: fs814/emacs
}


DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
       doc: /* Return a list of names of files in DIRECTORY.
There are three optional arguments:
If FULL is non-nil, return absolute file names.  Otherwise return names
 that are relative to the specified directory.
If MATCH is non-nil, mention only file names that match the regexp MATCH.
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
 Otherwise, the list returned is sorted with `string-lessp'.
 NOSORT is useful if you plan to sort the result yourself.  */)
  (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
{
  Lisp_Object handler;
  directory = Fexpand_file_name (directory, Qnil);

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (directory, Qdirectory_files);
  if (!NILP (handler))
    return call5 (handler, Qdirectory_files, directory,
                  full, match, nosort);

  return directory_files_internal (directory, full, match, nosort, 0, Qnil);
}

DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
       Sdirectory_files_and_attributes, 1, 5, 0,
       doc: /* Return a list of names of files and their attributes in DIRECTORY.
There are four optional arguments:
Esempio n. 6
0
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
{
  DIR *d;
  int directory_nbytes;
  Lisp_Object list, dirfilename, encoded_directory;
  struct re_pattern_buffer *bufp = NULL;
  int needsep = 0;
  int count = SPECPDL_INDEX ();
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  DIRENTRY *dp;
#ifdef WINDOWSNT
  Lisp_Object w32_save = Qnil;
#endif

  /* Because of file name handlers, these functions might call
     Ffuncall, and cause a GC.  */
  list = encoded_directory = dirfilename = Qnil;
  GCPRO5 (match, directory, list, dirfilename, encoded_directory);
  dirfilename = Fdirectory_file_name (directory);

  if (!NILP (match))
    {
      CHECK_STRING (match);

      /* MATCH might be a flawed regular expression.  Rather than
	 catching and signaling our own errors, we just call
	 compile_pattern to do the work for us.  */
      /* Pass 1 for the MULTIBYTE arg
	 because we do make multibyte strings if the contents warrant.  */
# ifdef WINDOWSNT
      /* Windows users want case-insensitive wildcards.  */
      bufp = compile_pattern (match, 0,
			      BVAR (&buffer_defaults, case_canon_table), 0, 1);
# else	/* !WINDOWSNT */
      bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif	 /* !WINDOWSNT */
    }

  /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
     run_pre_post_conversion_on_str which calls Lisp directly and
     indirectly.  */
  if (STRING_MULTIBYTE (dirfilename))
    dirfilename = ENCODE_FILE (dirfilename);
  encoded_directory = (STRING_MULTIBYTE (directory)
		       ? ENCODE_FILE (directory) : directory);

  /* Now *bufp is the compiled form of MATCH; don't call anything
     which might compile a new regexp until we're done with the loop!  */

  BLOCK_INPUT;
  d = opendir (SSDATA (dirfilename));
  UNBLOCK_INPUT;
  if (d == NULL)
    report_file_error ("Opening directory", Fcons (directory, Qnil));

  /* Unfortunately, we can now invoke expand-file-name and
     file-attributes on filenames, both of which can throw, so we must
     do a proper unwind-protect.  */
  record_unwind_protect (directory_files_internal_unwind,
			 make_save_value (d, 0));

#ifdef WINDOWSNT
  if (attrs)
    {
      extern int is_slow_fs (const char *);

      /* Do this only once to avoid doing it (in w32.c:stat) for each
	 file in the directory, when we call Ffile_attributes below.  */
      record_unwind_protect (directory_files_internal_w32_unwind,
			     Vw32_get_true_file_attributes);
      w32_save = Vw32_get_true_file_attributes;
      if (EQ (Vw32_get_true_file_attributes, Qlocal))
	{
	  /* w32.c:stat will notice these bindings and avoid calling
	     GetDriveType for each file.  */
	  if (is_slow_fs (SDATA (dirfilename)))
	    Vw32_get_true_file_attributes = Qnil;
	  else
	    Vw32_get_true_file_attributes = Qt;
	}
    }
#endif

  directory_nbytes = SBYTES (directory);
  re_match_object = Qt;

  /* Decide whether we need to add a directory separator.  */
  if (directory_nbytes == 0
      || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
    needsep = 1;

  /* Loop reading blocks until EOF or error.  */
  for (;;)
    {
      errno = 0;
      dp = readdir (d);

      if (dp == NULL && (0
#ifdef EAGAIN
			 || errno == EAGAIN
#endif
#ifdef EINTR
			 || errno == EINTR
#endif
			 ))
	{ QUIT; continue; }

      if (dp == NULL)
	break;

      if (DIRENTRY_NONEMPTY (dp))
	{
	  int len;
	  int wanted = 0;
	  Lisp_Object name, finalname;
	  struct gcpro gcpro1, gcpro2;

	  len = NAMLEN (dp);
	  name = finalname = make_unibyte_string (dp->d_name, len);
	  GCPRO2 (finalname, name);

	  /* Note: DECODE_FILE can GC; it should protect its argument,
	     though.  */
	  name = DECODE_FILE (name);
	  len = SBYTES (name);

	  /* Now that we have unwind_protect in place, we might as well
             allow matching to be interrupted.  */
	  immediate_quit = 1;
	  QUIT;

	  if (NILP (match)
	      || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0)))
	    wanted = 1;

	  immediate_quit = 0;

	  if (wanted)
	    {
	      if (!NILP (full))
		{
		  Lisp_Object fullname;
		  int nbytes = len + directory_nbytes + needsep;
		  int nchars;

		  fullname = make_uninit_multibyte_string (nbytes, nbytes);
		  memcpy (SDATA (fullname), SDATA (directory),
			  directory_nbytes);

		  if (needsep)
		    SSET (fullname, directory_nbytes, DIRECTORY_SEP);

		  memcpy (SDATA (fullname) + directory_nbytes + needsep,
			  SDATA (name), len);

		  nchars = chars_in_text (SDATA (fullname), nbytes);

		  /* Some bug somewhere.  */
		  if (nchars > nbytes)
		    abort ();

		  STRING_SET_CHARS (fullname, nchars);
		  if (nchars == nbytes)
		    STRING_SET_UNIBYTE (fullname);

		  finalname = fullname;
		}
	      else
		finalname = name;

	      if (attrs)
		{
		  /* Construct an expanded filename for the directory entry.
		     Use the decoded names for input to Ffile_attributes.  */
		  Lisp_Object decoded_fullname, fileattrs;
		  struct gcpro gcpro1, gcpro2;

		  decoded_fullname = fileattrs = Qnil;
		  GCPRO2 (decoded_fullname, fileattrs);

		  /* Both Fexpand_file_name and Ffile_attributes can GC.  */
		  decoded_fullname = Fexpand_file_name (name, directory);
		  fileattrs = Ffile_attributes (decoded_fullname, id_format);

		  list = Fcons (Fcons (finalname, fileattrs), list);
		  UNGCPRO;
		}
	      else
		list = Fcons (finalname, list);
	    }

	  UNGCPRO;
	}
    }

  BLOCK_INPUT;
  closedir (d);
  UNBLOCK_INPUT;
#ifdef WINDOWSNT
  if (attrs)
    Vw32_get_true_file_attributes = w32_save;
#endif

  /* Discard the unwind protect.  */
  specpdl_ptr = specpdl + count;

  if (NILP (nosort))
    list = Fsort (Fnreverse (list),
		  attrs ? Qfile_attributes_lessp : Qstring_lessp);

  RETURN_UNGCPRO (list);
}
Esempio n. 7
0
static time_t
get_boot_time (void)
{
#if defined (BOOT_TIME)
    int counter;
#endif

    if (boot_time_initialized)
        return boot_time;
    boot_time_initialized = 1;

#if defined (CTL_KERN) && defined (KERN_BOOTTIME)
    {
        int mib[2];
        size_t size;
        struct timeval boottime_val;

        mib[0] = CTL_KERN;
        mib[1] = KERN_BOOTTIME;
        size = sizeof (boottime_val);

        if (sysctl (mib, 2, &boottime_val, &size, NULL, 0) >= 0)
        {
            boot_time = boottime_val.tv_sec;
            return boot_time;
        }
    }
#endif /* defined (CTL_KERN) && defined (KERN_BOOTTIME) */

    if (BOOT_TIME_FILE)
    {
        struct stat st;
        if (stat (BOOT_TIME_FILE, &st) == 0)
        {
            boot_time = st.st_mtime;
            return boot_time;
        }
    }

#if defined (BOOT_TIME)
#ifndef CANNOT_DUMP
    /* The utmp routines maintain static state.
       Don't touch that state unless we are initialized,
       since it might not survive dumping.  */
    if (! initialized)
        return boot_time;
#endif /* not CANNOT_DUMP */

    /* Try to get boot time from utmp before wtmp,
       since utmp is typically much smaller than wtmp.
       Passing a null pointer causes get_boot_time_1
       to inspect the default file, namely utmp.  */
    get_boot_time_1 (0, 0);
    if (boot_time)
        return boot_time;

    /* Try to get boot time from the current wtmp file.  */
    get_boot_time_1 (WTMP_FILE, 1);

    /* If we did not find a boot time in wtmp, look at wtmp, and so on.  */
    for (counter = 0; counter < 20 && ! boot_time; counter++)
    {
        char cmd_string[sizeof WTMP_FILE ".19.gz"];
        Lisp_Object tempname, filename;
        bool delete_flag = 0;

        filename = Qnil;

        tempname = make_formatted_string
                   (cmd_string, "%s.%d", WTMP_FILE, counter);
        if (! NILP (Ffile_exists_p (tempname)))
            filename = tempname;
        else
        {
            tempname = make_formatted_string (cmd_string, "%s.%d.gz",
                                              WTMP_FILE, counter);
            if (! NILP (Ffile_exists_p (tempname)))
            {
                Lisp_Object args[6];

                /* The utmp functions on mescaline.gnu.org accept only
                file names up to 8 characters long.  Choose a 2
                 character long prefix, and call make_temp_file with
                 second arg non-zero, so that it will add not more
                 than 6 characters to the prefix.  */
                filename = Fexpand_file_name (build_string ("wt"),
                                              Vtemporary_file_directory);
                filename = make_temp_name (filename, 1);
                args[0] = build_string ("gzip");
                args[1] = Qnil;
                args[2] = list2 (QCfile, filename);
                args[3] = Qnil;
                args[4] = build_string ("-cd");
                args[5] = tempname;
                Fcall_process (6, args);
                delete_flag = 1;
            }
        }

        if (! NILP (filename))
        {
            get_boot_time_1 (SSDATA (filename), 1);
            if (delete_flag)
                unlink (SSDATA (filename));
        }
    }

    return boot_time;
#else
    return 0;
#endif
}