]> code.delx.au - gnu-emacs/blobdiff - src/filelock.c
(wait_reading_process_input, both versions):
[gnu-emacs] / src / filelock.c
index fc00647baba5402e00ec4b1bf997fad3468ff58d..33de9a4e7dbeeae3de84e317d9a231ce47513924 100644 (file)
@@ -1,4 +1,6 @@
-/* Copyright (C) 1985, 86, 87, 93, 94, 96 Free Software Foundation, Inc.
+/* Lock files for editing.
+   Copyright (C) 1985, 86, 87, 93, 94, 96, 98, 1999, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -18,10 +20,11 @@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
 
+#include <config.h>
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <signal.h>
-#include <config.h>
+#include <stdio.h>
 
 #ifdef VMS
 #include "vms-pwd.h"
@@ -30,30 +33,53 @@ Boston, MA 02111-1307, USA.  */
 #endif /* not VMS */
 
 #include <sys/file.h>
-#ifdef USG
+#ifdef HAVE_FCNTL_H
 #include <fcntl.h>
+#endif
+#ifdef HAVE_STRING_H
 #include <string.h>
-#endif /* USG */
+#endif
 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
 
+#ifdef __FreeBSD__
+#include <sys/sysctl.h>
+#endif /* __FreeBSD__ */
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
 #include "lisp.h"
 #include "buffer.h"
 #include "charset.h"
 #include "coding.h"
 #include "systime.h"
 
-#include <time.h>
-#include <errno.h>
-#ifndef errno
-extern int errno;
-#endif
+/* The directory for writing temporary files.  */
+
+Lisp_Object Vtemporary_file_directory;
 
 #ifdef CLASH_DETECTION
 
 #include <utmp.h>
+
+#if !defined (S_ISLNK) && defined (S_IFLNK)
+#define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
+#endif
+
+/* A file whose last-modified time is just after the most recent boot.
+   Define this to be NULL to disable checking for this file.  */
+#ifndef BOOT_TIME_FILE
+#define BOOT_TIME_FILE "/var/run/random-seed"
+#endif
+
+#ifndef WTMP_FILE
+#define WTMP_FILE "/var/log/wtmp"
+#endif
   
 /* The strategy: to lock a file FN, create a symlink .#FN in FN's
    directory, with link data `user@host.pid'.  This avoids a single
@@ -94,56 +120,75 @@ extern int errno;
 /* Return the time of the last system boot.  */
 
 static time_t boot_time;
+static int boot_time_initialized;
 
 extern Lisp_Object Vshell_file_name;
 
+#ifdef BOOT_TIME
+static void get_boot_time_1 P_ ((char *, int));
+#endif
+
 static time_t
 get_boot_time ()
 {
-#ifdef BOOT_TIME
-  struct utmp ut, *utp;
-  int fd;
-  EMACS_TIME time_before, after;
+#if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
   int counter;
+#endif
 
-  if (boot_time)
+  if (boot_time_initialized)
     return boot_time;
+  boot_time_initialized = 1;
 
-  EMACS_GET_TIME (time_before);
-
-  /* Try calculating the last boot time
-     from the uptime as obtained from /proc/uptime.  */
+#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) */
 
-  while ((fd = open ("/proc/uptime", O_RDONLY)) >= 0)
+  if (BOOT_TIME_FILE)
     {
-      char buf[BUFSIZ];
-      int res;
-      double upsecs;
-      time_t uptime;
-
-      read (fd, buf, BUFSIZ);
-      close (fd);
-
-      res = sscanf (buf, "%lf", &upsecs);
-
-      /* If the current time did not tick while we were getting the
-        uptime, we have a valid result.  */
-      EMACS_GET_TIME (after);
-      if (res == 1 && EMACS_SECS (after) == EMACS_SECS (time_before))
+      struct stat st;
+      if (stat (BOOT_TIME_FILE, &st) == 0)
        {
-         boot_time = EMACS_SECS (time_before) - (time_t) upsecs;
+         boot_time = st.st_mtime;
          return boot_time;
        }
-
-      /* Otherwise, try again to read the uptime.  */
-      time_before = after;
     }
 
+#if defined (BOOT_TIME) && ! defined (NO_WTMP_FILE)
+#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 ((char *) 0, 0);
+  if (boot_time)
+    return boot_time;
+
   /* Try to get boot time from the current wtmp file.  */
-  get_boot_time_1 ("/var/log/wtmp");
+  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 == 1; counter++)
+  for (counter = 0; counter < 20 && ! boot_time; counter++)
     {
       char cmd_string[100];
       Lisp_Object tempname, filename;
@@ -151,25 +196,33 @@ get_boot_time ()
 
       filename = Qnil;
 
-      sprintf (cmd_string, "/var/log/wtmp.%d", counter);
+      sprintf (cmd_string, "%s.%d", WTMP_FILE, counter);
       tempname = build_string (cmd_string);
-      if (! NILP (Ffile_exists_p (filename)))
+      if (! NILP (Ffile_exists_p (tempname)))
        filename = tempname;
       else
        {
-         sprintf (cmd_string, "/var/log/wtmp.%d.gz", counter);
+         sprintf (cmd_string, "%s.%d.gz", WTMP_FILE, counter);
          tempname = build_string (cmd_string);
          if (! NILP (Ffile_exists_p (tempname)))
            {
              Lisp_Object args[6];
-             tempname = Fmake_temp_name (build_string ("wtmp"));
+
+             /* 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.  */
+             tempname = Fexpand_file_name (build_string ("wt"),
+                                           Vtemporary_file_directory);
+             tempname = make_temp_name (tempname, 1);
              args[0] = Vshell_file_name;
              args[1] = Qnil;
              args[2] = Qnil;
              args[3] = Qnil;
              args[4] = build_string ("-c");
-             sprintf (cmd_string, "gunzip < /var/log/wtmp.%d.gz > %s",
-                      counter, XSTRING (tempname)->data);
+             sprintf (cmd_string, "gunzip < %s.%d.gz > %s",
+                      WTMP_FILE, counter, SDATA (tempname));
              args[5] = build_string (cmd_string);
              Fcall_process (6, args);
              filename = tempname;
@@ -179,9 +232,9 @@ get_boot_time ()
 
       if (! NILP (filename))
        {
-         get_boot_time_1 (XSTRING (filename)->data);
+         get_boot_time_1 (SDATA (filename), 1);
          if (delete_flag)
-           unlink (XSTRING (filename)->data);
+           unlink (SDATA (filename));
        }
     }
 
@@ -194,15 +247,37 @@ get_boot_time ()
 #ifdef BOOT_TIME
 /* Try to get the boot time from wtmp file FILENAME.
    This succeeds if that file contains a reboot record.
-   Success is indicated by setting BOOT_TIME.  */
 
-get_boot_time_1 (filename)
+   If FILENAME is zero, use the same file as before;
+   if no FILENAME has ever been specified, this is the utmp file.
+   Use the newest reboot record if NEWEST is nonzero,
+   the first reboot record otherwise.
+   Ignore all reboot records on or before BOOT_TIME.
+   Success is indicated by setting BOOT_TIME to a larger value.  */
+
+void
+get_boot_time_1 (filename, newest)
      char *filename;
+     int newest;
 {
   struct utmp ut, *utp;
+  int desc;
+
+  if (filename)
+    {
+      /* On some versions of IRIX, opening a nonexistent file name
+        is likely to crash in the utmp routines.  */
+      desc = emacs_open (filename, O_RDONLY, 0);
+      if (desc < 0)
+       return;
+
+      emacs_close (desc);
+
+      utmpname (filename);
+    }
 
-  utmpname (filename);
   setutent ();
+
   while (1)
     {
       /* Find the next reboot record.  */
@@ -212,7 +287,11 @@ get_boot_time_1 (filename)
        break;
       /* Compare reboot times and use the newest one.  */
       if (utp->ut_time > boot_time)
-       boot_time = utp->ut_time;
+       {
+         boot_time = utp->ut_time;
+         if (! newest)
+           break;
+       }
       /* Advance on element in the file
         so that getutid won't repeat the same one.  */
       utp = getutent ();
@@ -242,9 +321,11 @@ typedef struct
 
 
 /* Write the name of the lock file for FN into LFNAME.  Length will be
-   that of FN plus two more for the leading `.#' plus one for the null.  */
+   that of FN plus two more for the leading `.#' plus 1 for the
+   trailing period plus one for the digit after it plus one for the
+   null.  */
 #define MAKE_LOCK_NAME(lock, file) \
-  (lock = (char *) alloca (STRING_BYTES (XSTRING (file)) + 2 + 1), \
+  (lock = (char *) alloca (SBYTES (file) + 2 + 1 + 1 + 1), \
    fill_in_lock_file_name (lock, (file)))
 
 static void
@@ -253,8 +334,10 @@ fill_in_lock_file_name (lockfile, fn)
      register Lisp_Object fn;
 {
   register char *p;
+  struct stat st;
+  int count = 0;
 
-  strcpy (lockfile, XSTRING (fn)->data);
+  strcpy (lockfile, SDATA (fn));
 
   /* Shift the nondirectory part of the file name (including the null)
      right two characters.  Here is one of the places where we'd have to
@@ -265,6 +348,18 @@ fill_in_lock_file_name (lockfile, fn)
   /* Insert the `.#'.  */
   p[1] = '.';
   p[2] = '#';
+
+  p = p + strlen (p);
+
+  while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode))
+    {
+      if (count > 9)
+       {
+         *p = '\0';
+         return;
+       }
+      sprintf (p, ".%d", count++);
+    }
 }
 
 /* Lock the lock file named LFNAME.
@@ -283,11 +378,11 @@ lock_file_1 (lfname, force)
   char *lock_info_str;
 
   if (STRINGP (Fuser_login_name (Qnil)))
-    user_name = (char *)XSTRING (Fuser_login_name (Qnil))->data;
+    user_name = (char *)SDATA (Fuser_login_name (Qnil));
   else
     user_name = "";
   if (STRINGP (Fsystem_name ()))
-    host_name = (char *)XSTRING (Fsystem_name ())->data;
+    host_name = (char *)SDATA (Fsystem_name ());
   else
     host_name = "";
   lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name)
@@ -333,7 +428,7 @@ current_lock_owner (owner, lfname)
 #ifndef index
   extern char *rindex (), *index ();
 #endif
-  int o, p, len, ret;
+  int len, ret;
   int local_owner = 0;
   char *at, *dot, *colon;
   char *lfinfo = 0;
@@ -344,7 +439,13 @@ current_lock_owner (owner, lfname)
     {
       bufsize *= 2;
       lfinfo = (char *) xrealloc (lfinfo, bufsize);
+      errno = 0;
       len = readlink (lfname, lfinfo, bufsize);
+#ifdef ERANGE
+      /* HP-UX reports ERANGE if the buffer is too small.  */
+      if (len == -1 && errno == ERANGE)
+       len = bufsize;
+#endif
     }
   while (len >= bufsize);
   
@@ -402,7 +503,7 @@ current_lock_owner (owner, lfname)
   
   /* On current host?  */
   if (STRINGP (Fsystem_name ())
-      && strcmp (owner->host, XSTRING (Fsystem_name ())->data) == 0)
+      && strcmp (owner->host, SDATA (Fsystem_name ())) == 0)
     {
       if (owner->pid == getpid ())
         ret = 2; /* We own it.  */
@@ -444,7 +545,7 @@ lock_if_free (clasher, lfname)
      lock_info_type *clasher;
      register char *lfname; 
 {
-  if (lock_file_1 (lfname, 0) == 0)
+  while (lock_file_1 (lfname, 0) == 0)
     {
       int locker;
 
@@ -459,8 +560,10 @@ lock_if_free (clasher, lfname)
         }
       else if (locker == 1)
         return 1;  /* Someone else has it.  */
+      else if (locker == -1)
+       return -1;   /* current_lock_owner returned strange error.  */
 
-      return -1; /* Something's wrong.  */
+      /* We deleted a stale lock; try again to lock the file.  */
     }
   return 0;
 }
@@ -489,8 +592,16 @@ lock_file (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);
 
@@ -501,18 +612,16 @@ lock_file (fn)
      visited.  */
   {
     register Lisp_Object subject_buf;
-    struct gcpro gcpro1;
 
     subject_buf = get_truename_buffer (orig_fn);
-    GCPRO1 (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;
   }
+  UNGCPRO;
 
   /* Try to lock the lock. */
   if (lock_if_free (&lock_info, lfname) <= 0)
@@ -557,33 +666,28 @@ unlock_all_files ()
   register Lisp_Object tail;
   register struct buffer *b;
 
-  for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+  for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
     {
-      b = XBUFFER (XCONS (XCONS (tail)->car)->cdr);
+      b = XBUFFER (XCDR (XCAR (tail)));
       if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
        {
-         register char *lfname;
-
-         MAKE_LOCK_NAME (lfname, b->file_truename);
-
-         if (current_lock_owner (0, lfname) == 2)
-           unlink (lfname);
+         unlock_file(b->file_truename);
        }
     }
 }
 \f
 DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
-  0, 1, 0,
-  "Lock FILE, if current buffer is modified.\n\
-FILE defaults to current buffer's visited file,\n\
-or else nothing is done if current buffer isn't visiting a file.")
-  (file)
+       0, 1, 0,
+       doc: /* Lock FILE, if current buffer is modified.
+FILE defaults to current buffer's visited file,
+or else nothing is done if current buffer isn't visiting a file.  */)
+     (file)
      Lisp_Object file;
 {
   if (NILP (file))
     file = current_buffer->file_truename;
   else
-    CHECK_STRING (file, 0);
+    CHECK_STRING (file);
   if (SAVE_MODIFF < MODIFF
       && !NILP (file))
     lock_file (file);
@@ -591,10 +695,11 @@ or else nothing is done if current buffer isn't visiting a file.")
 }
 
 DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
-  0, 0, 0,
- "Unlock the file visited in the current buffer,\n\
-if it should normally be locked.")
-  ()
+       0, 0, 0,
+       doc: /* Unlock the file visited in the current buffer.
+If the buffer is not modified, this does nothing because the file
+should not be locked in that case.  */)
+     ()
 {
   if (SAVE_MODIFF < MODIFF
       && STRINGP (current_buffer->file_truename))
@@ -613,11 +718,12 @@ unlock_buffer (buffer)
     unlock_file (buffer->file_truename);
 }
 
-DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 0, 1, 0,
-  "Return nil if the FILENAME is not locked,\n\
-t if it is locked by you, else a string of the name of the locker.")
-  (filename)
-  Lisp_Object filename;
+DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
+       doc: /* Return a value indicating whether FILENAME is locked.
+The value is nil if the FILENAME is not locked,
+t if it is locked by you, else a string saying which user has locked it.  */)
+     (filename)
+     Lisp_Object filename;
 {
   Lisp_Object ret;
   register char *lfname;
@@ -644,9 +750,20 @@ t if it is locked by you, else a string of the name of the locker.")
 \f
 /* Initialization functions.  */
 
+void
+init_filelock ()
+{
+  boot_time = 0;
+  boot_time_initialized = 0;
+}
+
 void
 syms_of_filelock ()
 {
+  DEFVAR_LISP ("temporary-file-directory", &Vtemporary_file_directory,
+              doc: /* The directory for writing temporary files.  */);
+  Vtemporary_file_directory = Qnil;
+
   defsubr (&Sunlock_buffer);
   defsubr (&Slock_buffer);
   defsubr (&Sfile_locked_p);